ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.252 by root, Wed Apr 18 15:28:18 2007 UTC vs.
Revision 1.264 by root, Sun May 6 05:44:48 2007 UTC

… …
54our %EXT_CORO = (); # coroutines bound to extensions 54our %EXT_CORO = (); # coroutines bound to extensions
55our %EXT_MAP = (); # pluggable maps 55our %EXT_MAP = (); # pluggable maps
56 56
57our $RELOAD; # number of reloads so far 57our $RELOAD; # number of reloads so far
58our @EVENT; 58our @EVENT;
59our $LIBDIR = datadir . "/ext"; 59
60our $CONFDIR = confdir;
61our $DATADIR = datadir;
62our $LIBDIR = "$DATADIR/ext";
63our $PODDIR = "$DATADIR/pod";
64our $MAPDIR = "$DATADIR/" . mapdir;
65our $LOCALDIR = localdir;
66our $TMPDIR = "$LOCALDIR/" . tmpdir;
67our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
68our $PLAYERDIR = "$LOCALDIR/" . playerdir;
69our $RANDOMDIR = "$LOCALDIR/random";
70our $BDBDIR = "$LOCALDIR/db";
60 71
61our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 72our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
62our $TICK_WATCHER; 73our $TICK_WATCHER;
63our $AIO_POLL_WATCHER; 74our $AIO_POLL_WATCHER;
64our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 75our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
… …
75our $RUNTIME; 86our $RUNTIME;
76 87
77our %PLAYER; # all users 88our %PLAYER; # all users
78our %MAP; # all maps 89our %MAP; # all maps
79our $LINK_MAP; # the special {link} map, which is always available 90our $LINK_MAP; # the special {link} map, which is always available
80our $RANDOM_MAPS = cf::localdir . "/random";
81our $BDB_ENV_DIR = cf::localdir . "/db";
82 91
83# used to convert map paths into valid unix filenames by replacing / by ∕ 92# used to convert map paths into valid unix filenames by replacing / by ∕
84our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 93our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
85 94
86binmode STDOUT; 95binmode STDOUT;
87binmode STDERR; 96binmode STDERR;
88 97
89# read virtual server time, if available 98# read virtual server time, if available
90unless ($RUNTIME || !-e cf::localdir . "/runtime") { 99unless ($RUNTIME || !-e "$LOCALDIR/runtime") {
91 open my $fh, "<", cf::localdir . "/runtime" 100 open my $fh, "<", "$LOCALDIR/runtime"
92 or die "unable to read runtime file: $!"; 101 or die "unable to read runtime file: $!";
93 $RUNTIME = <$fh> + 0.; 102 $RUNTIME = <$fh> + 0.;
94} 103}
95 104
96mkdir cf::localdir; 105mkdir $_
97mkdir cf::localdir . "/" . cf::playerdir; 106 for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR;
98mkdir cf::localdir . "/" . cf::tmpdir;
99mkdir cf::localdir . "/" . cf::uniquedir;
100mkdir $RANDOM_MAPS;
101mkdir $BDB_ENV_DIR;
102 107
103our $EMERGENCY_POSITION; 108our $EMERGENCY_POSITION;
104 109
105sub cf::map::normalise; 110sub cf::map::normalise;
106 111
… …
117=item $cf::RUNTIME 122=item $cf::RUNTIME
118 123
119The time this server has run, starts at 0 and is increased by $cf::TICK on 124The time this server has run, starts at 0 and is increased by $cf::TICK on
120every server tick. 125every server tick.
121 126
122=item $cf::LIBDIR 127=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR
128$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR
129$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR
123 130
124The perl library directory, where extensions and cf-specific modules can 131Various directories - "/etc", read-only install directory, perl-library
125be found. It will be added to C<@INC> automatically. 132directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
133unique-items directory, player file directory, random maps directory and
134database environment.
126 135
127=item $cf::NOW 136=item $cf::NOW
128 137
129The time of the last (current) server tick. 138The time of the last (current) server tick.
130 139
… …
152 my $msg = join "", @_; 161 my $msg = join "", @_;
153 162
154 $msg .= "\n" 163 $msg .= "\n"
155 unless $msg =~ /\n$/; 164 unless $msg =~ /\n$/;
156 165
157 $msg =~ s/([\x00-\x09\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 166 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
158 167
159 utf8::encode $msg; 168 utf8::encode $msg;
160 LOG llevError, $msg; 169 LOG llevError, $msg;
161 }; 170 };
162} 171}
… …
234returned. 243returned.
235 244
236Lock names should begin with a unique identifier (for example, cf::map::find 245Lock names should begin with a unique identifier (for example, cf::map::find
237uses map_find and cf::map::load uses map_load). 246uses map_find and cf::map::load uses map_load).
238 247
248=item $locked = cf::lock_active $string
249
250Return true if the lock is currently active, i.e. somebody has locked it.
251
239=cut 252=cut
240 253
241our %LOCK; 254our %LOCK;
242 255
243sub lock_wait($) { 256sub lock_wait($) {
… …
260 273
261 Coro::guard { 274 Coro::guard {
262 # wake up all waiters, to be on the safe side 275 # wake up all waiters, to be on the safe side
263 $_->ready for @{ delete $LOCK{$key} }; 276 $_->ready for @{ delete $LOCK{$key} };
264 } 277 }
278}
279
280sub lock_active($) {
281 my ($key) = @_;
282
283 ! ! $LOCK{$key}
265} 284}
266 285
267sub freeze_mainloop { 286sub freeze_mainloop {
268 return unless $TICK_WATCHER->is_active; 287 return unless $TICK_WATCHER->is_active;
269 288
… …
348 367
349 $coro 368 $coro
350} 369}
351 370
352sub write_runtime { 371sub write_runtime {
372 my $runtime = "$LOCALDIR/runtime";
373
374 # first touch the runtime file to show we are still running:
375 # the fsync below can take a very very long time.
376
377 warn "touching runtime...\n";#d#
378 if (my $fh = aio_open $runtime, O_WRONLY, 0) {
379 utime undef, undef, $fh;
380 }
381
353 my $guard = cf::lock_acquire "write_runtime"; 382 my $guard = cf::lock_acquire "write_runtime";
354 383
355 my $runtime = cf::localdir . "/runtime"; 384 warn "starting to write runtime...\n";#d#
356
357 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 385 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
358 or return; 386 or return;
359 387
360 my $value = $cf::RUNTIME + 90 + 10; 388 my $value = $cf::RUNTIME + 90 + 10;
361 # 10 is the runtime save interval, for a monotonic clock 389 # 10 is the runtime save interval, for a monotonic clock
… …
366 394
367 # always fsync - this file is important 395 # always fsync - this file is important
368 aio_fsync $fh 396 aio_fsync $fh
369 and return; 397 and return;
370 398
399 # touch it again to show we are up-to-date
400 utime undef, undef, $fh;
401
371 close $fh 402 close $fh
372 or return; 403 or return;
373 404
374 aio_rename "$runtime~", $runtime 405 aio_rename "$runtime~", $runtime
375 and return; 406 and return;
407
408 warn "... done writing runtime.\n";#d#
376 409
377 1 410 1
378} 411}
379 412
380=item cf::datalog type => key => value, ... 413=item cf::datalog type => key => value, ...
… …
955Returns the given player object, loading it if necessary (might block). 988Returns the given player object, loading it if necessary (might block).
956 989
957=cut 990=cut
958 991
959sub playerdir($) { 992sub playerdir($) {
960 cf::localdir 993 "$PLAYERDIR/"
961 . "/"
962 . cf::playerdir
963 . "/"
964 . (ref $_[0] ? $_[0]->ob->name : $_[0]) 994 . (ref $_[0] ? $_[0]->ob->name : $_[0])
965} 995}
966 996
967sub path($) { 997sub path($) {
968 my $login = ref $_[0] ? $_[0]->ob->name : $_[0]; 998 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
… …
1088while and may block, so not sync_job-capable, ever. 1118while and may block, so not sync_job-capable, ever.
1089 1119
1090=cut 1120=cut
1091 1121
1092sub list_logins { 1122sub list_logins {
1093 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir 1123 my $dirs = aio_readdir $PLAYERDIR
1094 or return []; 1124 or return [];
1095 1125
1096 my @logins; 1126 my @logins;
1097 1127
1098 for my $login (@$dirs) { 1128 for my $login (@$dirs) {
… …
1336 1366
1337# the original (read-only) location 1367# the original (read-only) location
1338sub load_path { 1368sub load_path {
1339 my ($self) = @_; 1369 my ($self) = @_;
1340 1370
1341 sprintf "%s/%s/%s.map", cf::datadir, cf::mapdir, $self->{path} 1371 "$MAPDIR/$self->{path}.map"
1342} 1372}
1343 1373
1344# the temporary/swap location 1374# the temporary/swap location
1345sub save_path { 1375sub save_path {
1346 my ($self) = @_; 1376 my ($self) = @_;
1347 1377
1348 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1378 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1349 sprintf "%s/%s/%s.map", cf::localdir, cf::tmpdir, $path 1379 "$TMPDIR/$path.map"
1350} 1380}
1351 1381
1352# the unique path, undef == no special unique path 1382# the unique path, undef == no special unique path
1353sub uniq_path { 1383sub uniq_path {
1354 my ($self) = @_; 1384 my ($self) = @_;
1355 1385
1356 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1386 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1357 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $path 1387 "$UNIQUEDIR/$path"
1358} 1388}
1359 1389
1360# and all this just because we cannot iterate over 1390# and all this just because we cannot iterate over
1361# all maps in C++... 1391# all maps in C++...
1362sub change_all_map_light { 1392sub change_all_map_light {
… …
1474 my ($self) = @_; 1504 my ($self) = @_;
1475 1505
1476 local $self->{deny_reset} = 1; # loading can take a long time 1506 local $self->{deny_reset} = 1; # loading can take a long time
1477 1507
1478 my $path = $self->{path}; 1508 my $path = $self->{path};
1509
1510 {
1479 my $guard = cf::lock_acquire "map_load:$path"; 1511 my $guard = cf::lock_acquire "map_load:$path";
1480 1512
1481 return if $self->in_memory != cf::MAP_SWAPPED; 1513 return if $self->in_memory != cf::MAP_SWAPPED;
1482 1514
1483 $self->in_memory (cf::MAP_LOADING); 1515 $self->in_memory (cf::MAP_LOADING);
1484 1516
1485 $self->alloc; 1517 $self->alloc;
1486 1518
1487 $self->pre_load; 1519 $self->pre_load;
1488 Coro::cede;
1489
1490 $self->_load_objects ($self->{load_path}, 1)
1491 or return;
1492
1493 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1494 if delete $self->{load_original};
1495
1496 if (my $uniq = $self->uniq_path) {
1497 utf8::encode $uniq;
1498 if (aio_open $uniq, O_RDONLY, 0) {
1499 $self->clear_unique_items;
1500 $self->_load_objects ($uniq, 0);
1501 }
1502 }
1503
1504 Coro::cede;
1505 # now do the right thing for maps
1506 $self->link_multipart_objects;
1507 Coro::cede;
1508
1509 unless ($self->{deny_activate}) {
1510 $self->decay_objects;
1511 $self->fix_auto_apply;
1512 $self->update_buttons;
1513 Coro::cede; 1520 Coro::cede;
1514 $self->set_darkness_map; 1521
1522 $self->_load_objects ($self->{load_path}, 1)
1523 or return;
1524
1525 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1526 if delete $self->{load_original};
1527
1528 if (my $uniq = $self->uniq_path) {
1529 utf8::encode $uniq;
1530 if (aio_open $uniq, O_RDONLY, 0) {
1531 $self->clear_unique_items;
1532 $self->_load_objects ($uniq, 0);
1533 }
1534 }
1535
1536 Coro::cede;
1537 # now do the right thing for maps
1538 $self->link_multipart_objects;
1515 $self->difficulty ($self->estimate_difficulty) 1539 $self->difficulty ($self->estimate_difficulty)
1516 unless $self->difficulty; 1540 unless $self->difficulty;
1517 Coro::cede; 1541 Coro::cede;
1542
1543 unless ($self->{deny_activate}) {
1544 $self->decay_objects;
1545 $self->fix_auto_apply;
1546 $self->update_buttons;
1547 Coro::cede;
1548 $self->set_darkness_map;
1549 Coro::cede;
1518 $self->activate; 1550 $self->activate;
1519 Coro::cede; 1551 }
1552
1553 $self->in_memory (cf::MAP_IN_MEMORY);
1520 } 1554 }
1521 1555
1522 $self->post_load; 1556 $self->post_load;
1523 Coro::cede;
1524
1525 $self->in_memory (cf::MAP_IN_MEMORY);
1526} 1557}
1527 1558
1528sub customise_for { 1559sub customise_for {
1529 my ($self, $ob) = @_; 1560 my ($self, $ob) = @_;
1530 1561
… …
1721instantiated unique items. May block. 1752instantiated unique items. May block.
1722 1753
1723=cut 1754=cut
1724 1755
1725sub unique_maps() { 1756sub unique_maps() {
1726 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir 1757 my $files = aio_readdir $UNIQUEDIR
1727 or return; 1758 or return;
1728 1759
1729 my @paths; 1760 my @paths;
1730 1761
1731 for (@$files) { 1762 for (@$files) {
… …
1987 2018
1988 $rmp->{random_seed} ||= $exit->random_seed; 2019 $rmp->{random_seed} ||= $exit->random_seed;
1989 2020
1990 my $data = cf::to_json $rmp; 2021 my $data = cf::to_json $rmp;
1991 my $md5 = Digest::MD5::md5_hex $data; 2022 my $md5 = Digest::MD5::md5_hex $data;
1992 my $meta = "$cf::RANDOM_MAPS/$md5.meta"; 2023 my $meta = "$RANDOMDIR/$md5.meta";
1993 2024
1994 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2025 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
1995 aio_write $fh, 0, (length $data), $data, 0; 2026 aio_write $fh, 0, (length $data), $data, 0;
1996 undef $fh; 2027 undef $fh;
1997 aio_rename "$meta~", $meta; 2028 aio_rename "$meta~", $meta;
… …
2373 2404
2374 return db_get cache => "$id/data"; 2405 return db_get cache => "$id/data";
2375 } 2406 }
2376 } 2407 }
2377 2408
2409 my $t1 = Time::HiRes::time;
2378 my $data = $process->(\@data); 2410 my $data = $process->(\@data);
2411 my $t2 = Time::HiRes::time;
2412
2413 warn "cache: '$id' processed in ", $t2 - $t1, "s\n";
2379 2414
2380 db_put cache => "$id/data", $data; 2415 db_put cache => "$id/data", $data;
2381 db_put cache => "$id/md5" , $md5; 2416 db_put cache => "$id/md5" , $md5;
2382 db_put cache => "$id/meta", $meta; 2417 db_put cache => "$id/meta", $meta;
2383 2418
… …
2414 2449
2415 die $$res unless "ARRAY" eq ref $res; 2450 die $$res unless "ARRAY" eq ref $res;
2416 2451
2417 return wantarray ? @$res : $res->[-1]; 2452 return wantarray ? @$res : $res->[-1];
2418 } else { 2453 } else {
2454 reset_signals;
2419 local $SIG{__WARN__}; 2455 local $SIG{__WARN__};
2456 local $SIG{__DIE__};
2420 eval { 2457 eval {
2421 local $SIG{__DIE__};
2422 close $fh1; 2458 close $fh1;
2423 2459
2424 my @res = eval { $cb->(@args) }; 2460 my @res = eval { $cb->(@args) };
2425 syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); 2461 syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res);
2426 }; 2462 };
… …
2485 } 2521 }
2486 2522
2487 1 2523 1
2488} 2524}
2489 2525
2526sub reload_regions {
2527 load_resource_file "$MAPDIR/regions"
2528 or die "unable to load regions file\n";
2529}
2530
2490sub reload_facedata { 2531sub reload_facedata {
2491 load_facedata sprintf "%s/facedata", cf::datadir 2532 load_facedata "$DATADIR/facedata"
2492 or die "unable to load facedata\n"; 2533 or die "unable to load facedata\n";
2493} 2534}
2494 2535
2495sub reload_regions {
2496 load_resource_file sprintf "%s/%s/regions", cf::datadir, cf::mapdir
2497 or die "unable to load regions file\n";
2498}
2499
2500sub reload_archetypes { 2536sub reload_archetypes {
2501 load_resource_file sprintf "%s/archetypes", cf::datadir 2537 load_resource_file "$DATADIR/archetypes"
2502 or die "unable to load archetypes\n"; 2538 or die "unable to load archetypes\n";
2503} 2539}
2504 2540
2505sub reload_treasures { 2541sub reload_treasures {
2506 load_resource_file sprintf "%s/treasures", cf::datadir 2542 load_resource_file "$DATADIR/treasures"
2507 or die "unable to load treasurelists\n"; 2543 or die "unable to load treasurelists\n";
2508} 2544}
2509 2545
2510sub reload_resources { 2546sub reload_resources {
2511 warn "reloading resource files...\n"; 2547 warn "reloading resource files...\n";
… …
2521sub init { 2557sub init {
2522 reload_resources; 2558 reload_resources;
2523} 2559}
2524 2560
2525sub cfg_load { 2561sub cfg_load {
2526 open my $fh, "<:utf8", cf::confdir . "/config" 2562 open my $fh, "<:utf8", "$CONFDIR/config"
2527 or return; 2563 or return;
2528 2564
2529 local $/; 2565 local $/;
2530 *CFG = YAML::Syck::Load <$fh>; 2566 *CFG = YAML::Syck::Load <$fh>;
2531 2567
… …
2871 2907
2872 cf::sync_job { 2908 cf::sync_job {
2873 eval { 2909 eval {
2874 BDB::db_env_open 2910 BDB::db_env_open
2875 $DB_ENV, 2911 $DB_ENV,
2876 $BDB_ENV_DIR, 2912 $BDBDIR,
2877 BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN 2913 BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
2878 | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE, 2914 | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
2879 0666; 2915 0666;
2880 2916
2881 cf::cleanup "db_env_open($BDB_ENV_DIR): $!" if $!; 2917 cf::cleanup "db_env_open($BDBDIR): $!" if $!;
2882 2918
2883 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1); 2919 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1);
2884 $DB_ENV->set_lk_detect; 2920 $DB_ENV->set_lk_detect;
2885 }; 2921 };
2886 2922
… …
2902 prio => 6, 2938 prio => 6,
2903 cb => \&IO::AIO::poll_cb, 2939 cb => \&IO::AIO::poll_cb,
2904 ); 2940 );
2905} 2941}
2906 2942
2943my $_log_backtrace;
2944
2945sub _log_backtrace {
2946 my ($msg, @addr) = @_;
2947
2948 $msg =~ s/\n//;
2949
2950 # limit the # of concurrent backtraces
2951 if ($_log_backtrace < 2) {
2952 ++$_log_backtrace;
2953 async {
2954 my @bt = fork_call {
2955 @addr = map { sprintf "%x", $_ } @addr;
2956 my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X;
2957 open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |"
2958 or die "addr2line: $!";
2959
2960 my @funcs;
2961 my @res = <$fh>;
2962 chomp for @res;
2963 while (@res) {
2964 my ($func, $line) = splice @res, 0, 2, ();
2965 push @funcs, "[$func] $line";
2966 }
2967
2968 @funcs
2969 };
2970
2971 LOG llevInfo, "[ABT] $msg\n";
2972 LOG llevInfo, "[ABT] $_\n" for @bt;
2973 --$_log_backtrace;
2974 };
2975 } else {
2976 LOG llevInfo, "[ABT] $msg\n";
2977 LOG llevInfo, "[ABT] [suppressed]\n";
2978 }
2979}
2980
2907# load additional modules 2981# load additional modules
2908use cf::pod; 2982use cf::pod;
2909 2983
2910END { cf::emergency_save } 2984END { cf::emergency_save }
2911 2985

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines