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.250 by root, Wed Apr 18 14:24:10 2007 UTC vs.
Revision 1.263 by root, Sat May 5 05:40:27 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
… …
350} 369}
351 370
352sub write_runtime { 371sub write_runtime {
353 my $guard = cf::lock_acquire "write_runtime"; 372 my $guard = cf::lock_acquire "write_runtime";
354 373
355 my $runtime = cf::localdir . "/runtime"; 374 my $runtime = "$LOCALDIR/runtime";
356 375
376 warn "starting to write runtime...\n";#d#
357 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 377 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
358 or return; 378 or return;
359 379
360 my $value = $cf::RUNTIME + 90 + 10; 380 my $value = $cf::RUNTIME + 90 + 10;
361 # 10 is the runtime save interval, for a monotonic clock 381 # 10 is the runtime save interval, for a monotonic clock
… …
371 close $fh 391 close $fh
372 or return; 392 or return;
373 393
374 aio_rename "$runtime~", $runtime 394 aio_rename "$runtime~", $runtime
375 and return; 395 and return;
396
397 warn "... done writing runtime.\n";#d#
376 398
377 1 399 1
378} 400}
379 401
380=item cf::datalog type => key => value, ... 402=item cf::datalog type => key => value, ...
… …
955Returns the given player object, loading it if necessary (might block). 977Returns the given player object, loading it if necessary (might block).
956 978
957=cut 979=cut
958 980
959sub playerdir($) { 981sub playerdir($) {
960 cf::localdir 982 "$PLAYERDIR/"
961 . "/"
962 . cf::playerdir
963 . "/"
964 . (ref $_[0] ? $_[0]->ob->name : $_[0]) 983 . (ref $_[0] ? $_[0]->ob->name : $_[0])
965} 984}
966 985
967sub path($) { 986sub path($) {
968 my $login = ref $_[0] ? $_[0]->ob->name : $_[0]; 987 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
… …
1088while and may block, so not sync_job-capable, ever. 1107while and may block, so not sync_job-capable, ever.
1089 1108
1090=cut 1109=cut
1091 1110
1092sub list_logins { 1111sub list_logins {
1093 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir 1112 my $dirs = aio_readdir $PLAYERDIR
1094 or return []; 1113 or return [];
1095 1114
1096 my @logins; 1115 my @logins;
1097 1116
1098 for my $login (@$dirs) { 1117 for my $login (@$dirs) {
… …
1336 1355
1337# the original (read-only) location 1356# the original (read-only) location
1338sub load_path { 1357sub load_path {
1339 my ($self) = @_; 1358 my ($self) = @_;
1340 1359
1341 sprintf "%s/%s/%s.map", cf::datadir, cf::mapdir, $self->{path} 1360 "$MAPDIR/$self->{path}.map"
1342} 1361}
1343 1362
1344# the temporary/swap location 1363# the temporary/swap location
1345sub save_path { 1364sub save_path {
1346 my ($self) = @_; 1365 my ($self) = @_;
1347 1366
1348 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1367 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1349 sprintf "%s/%s/%s.map", cf::localdir, cf::tmpdir, $path 1368 "$TMPDIR/$path.map"
1350} 1369}
1351 1370
1352# the unique path, undef == no special unique path 1371# the unique path, undef == no special unique path
1353sub uniq_path { 1372sub uniq_path {
1354 my ($self) = @_; 1373 my ($self) = @_;
1355 1374
1356 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1375 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1357 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $path 1376 "$UNIQUEDIR/$path"
1358} 1377}
1359 1378
1360# and all this just because we cannot iterate over 1379# and all this just because we cannot iterate over
1361# all maps in C++... 1380# all maps in C++...
1362sub change_all_map_light { 1381sub change_all_map_light {
… …
1474 my ($self) = @_; 1493 my ($self) = @_;
1475 1494
1476 local $self->{deny_reset} = 1; # loading can take a long time 1495 local $self->{deny_reset} = 1; # loading can take a long time
1477 1496
1478 my $path = $self->{path}; 1497 my $path = $self->{path};
1498
1499 {
1479 my $guard = cf::lock_acquire "map_load:$path"; 1500 my $guard = cf::lock_acquire "map_load:$path";
1480 1501
1481 return if $self->in_memory != cf::MAP_SWAPPED; 1502 return if $self->in_memory != cf::MAP_SWAPPED;
1482 1503
1483 $self->in_memory (cf::MAP_LOADING); 1504 $self->in_memory (cf::MAP_LOADING);
1484 1505
1485 $self->alloc; 1506 $self->alloc;
1486 1507
1487 $self->pre_load; 1508 $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; 1509 Coro::cede;
1514 $self->set_darkness_map; 1510
1511 $self->_load_objects ($self->{load_path}, 1)
1512 or return;
1513
1514 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1515 if delete $self->{load_original};
1516
1517 if (my $uniq = $self->uniq_path) {
1518 utf8::encode $uniq;
1519 if (aio_open $uniq, O_RDONLY, 0) {
1520 $self->clear_unique_items;
1521 $self->_load_objects ($uniq, 0);
1522 }
1523 }
1524
1525 Coro::cede;
1526 # now do the right thing for maps
1527 $self->link_multipart_objects;
1515 $self->difficulty ($self->estimate_difficulty) 1528 $self->difficulty ($self->estimate_difficulty)
1516 unless $self->difficulty; 1529 unless $self->difficulty;
1517 Coro::cede; 1530 Coro::cede;
1531
1532 unless ($self->{deny_activate}) {
1533 $self->decay_objects;
1534 $self->fix_auto_apply;
1535 $self->update_buttons;
1536 Coro::cede;
1537 $self->set_darkness_map;
1538 Coro::cede;
1518 $self->activate; 1539 $self->activate;
1519 Coro::cede; 1540 }
1541
1542 $self->in_memory (cf::MAP_IN_MEMORY);
1520 } 1543 }
1521 1544
1522 $self->post_load; 1545 $self->post_load;
1523 Coro::cede;
1524
1525 $self->in_memory (cf::MAP_IN_MEMORY);
1526} 1546}
1527 1547
1528sub customise_for { 1548sub customise_for {
1529 my ($self, $ob) = @_; 1549 my ($self, $ob) = @_;
1530 1550
… …
1721instantiated unique items. May block. 1741instantiated unique items. May block.
1722 1742
1723=cut 1743=cut
1724 1744
1725sub unique_maps() { 1745sub unique_maps() {
1726 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir 1746 my $files = aio_readdir $UNIQUEDIR
1727 or return; 1747 or return;
1728 1748
1729 my @paths; 1749 my @paths;
1730 1750
1731 for (@$files) { 1751 for (@$files) {
… …
1987 2007
1988 $rmp->{random_seed} ||= $exit->random_seed; 2008 $rmp->{random_seed} ||= $exit->random_seed;
1989 2009
1990 my $data = cf::to_json $rmp; 2010 my $data = cf::to_json $rmp;
1991 my $md5 = Digest::MD5::md5_hex $data; 2011 my $md5 = Digest::MD5::md5_hex $data;
1992 my $meta = "$cf::RANDOM_MAPS/$md5.meta"; 2012 my $meta = "$RANDOMDIR/$md5.meta";
1993 2013
1994 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2014 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
1995 aio_write $fh, 0, (length $data), $data, 0; 2015 aio_write $fh, 0, (length $data), $data, 0;
1996 undef $fh; 2016 undef $fh;
1997 aio_rename "$meta~", $meta; 2017 aio_rename "$meta~", $meta;
… …
2373 2393
2374 return db_get cache => "$id/data"; 2394 return db_get cache => "$id/data";
2375 } 2395 }
2376 } 2396 }
2377 2397
2398 my $t1 = Time::HiRes::time;
2378 my $data = $process->(\@data); 2399 my $data = $process->(\@data);
2400 my $t2 = Time::HiRes::time;
2401
2402 warn "cache: '$id' processed in ", $t2 - $t1, "s\n";
2379 2403
2380 db_put cache => "$id/data", $data; 2404 db_put cache => "$id/data", $data;
2381 db_put cache => "$id/md5" , $md5; 2405 db_put cache => "$id/md5" , $md5;
2382 db_put cache => "$id/meta", $meta; 2406 db_put cache => "$id/meta", $meta;
2383 2407
… …
2414 2438
2415 die $$res unless "ARRAY" eq ref $res; 2439 die $$res unless "ARRAY" eq ref $res;
2416 2440
2417 return wantarray ? @$res : $res->[-1]; 2441 return wantarray ? @$res : $res->[-1];
2418 } else { 2442 } else {
2443 reset_signals;
2444 local $SIG{__WARN__};
2445 local $SIG{__DIE__};
2419 eval { 2446 eval {
2420 local $SIG{__DIE__};
2421 local $SIG{__WARN__};
2422 close $fh1; 2447 close $fh1;
2423 2448
2424 my @res = eval { $cb->(@args) }; 2449 my @res = eval { $cb->(@args) };
2425 syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); 2450 syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res);
2426 }; 2451 };
2427 2452
2453 warn $@ if $@;
2428 _exit 0; 2454 _exit 0;
2429 } 2455 }
2430} 2456}
2431 2457
2432 2458
… …
2484 } 2510 }
2485 2511
2486 1 2512 1
2487} 2513}
2488 2514
2515sub reload_regions {
2516 load_resource_file "$MAPDIR/regions"
2517 or die "unable to load regions file\n";
2518}
2519
2489sub reload_facedata { 2520sub reload_facedata {
2490 load_facedata sprintf "%s/facedata", cf::datadir 2521 load_facedata "$DATADIR/facedata"
2491 or die "unable to load facedata\n"; 2522 or die "unable to load facedata\n";
2492} 2523}
2493 2524
2494sub reload_regions {
2495 load_resource_file sprintf "%s/%s/regions", cf::datadir, cf::mapdir
2496 or die "unable to load regions file\n";
2497}
2498
2499sub reload_archetypes { 2525sub reload_archetypes {
2500 load_resource_file sprintf "%s/archetypes", cf::datadir 2526 load_resource_file "$DATADIR/archetypes"
2501 or die "unable to load archetypes\n"; 2527 or die "unable to load archetypes\n";
2502} 2528}
2503 2529
2504sub reload_treasures { 2530sub reload_treasures {
2505 load_resource_file sprintf "%s/treasures", cf::datadir 2531 load_resource_file "$DATADIR/treasures"
2506 or die "unable to load treasurelists\n"; 2532 or die "unable to load treasurelists\n";
2507} 2533}
2508 2534
2509sub reload_resources { 2535sub reload_resources {
2510 warn "reloading resource files...\n"; 2536 warn "reloading resource files...\n";
… …
2520sub init { 2546sub init {
2521 reload_resources; 2547 reload_resources;
2522} 2548}
2523 2549
2524sub cfg_load { 2550sub cfg_load {
2525 open my $fh, "<:utf8", cf::confdir . "/config" 2551 open my $fh, "<:utf8", "$CONFDIR/config"
2526 or return; 2552 or return;
2527 2553
2528 local $/; 2554 local $/;
2529 *CFG = YAML::Syck::Load <$fh>; 2555 *CFG = YAML::Syck::Load <$fh>;
2530 2556
… …
2700 Symbol::delete_package "safe::$_" 2726 Symbol::delete_package "safe::$_"
2701 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2727 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2702 2728
2703 warn "unloading cf.pm \"a bit\""; 2729 warn "unloading cf.pm \"a bit\"";
2704 delete $INC{"cf.pm"}; 2730 delete $INC{"cf.pm"};
2731 delete $INC{"cf/pod.pm"};
2705 2732
2706 # don't, removes xs symbols, too, 2733 # don't, removes xs symbols, too,
2707 # and global variables created in xs 2734 # and global variables created in xs
2708 #Symbol::delete_package __PACKAGE__; 2735 #Symbol::delete_package __PACKAGE__;
2709 2736
… …
2869 2896
2870 cf::sync_job { 2897 cf::sync_job {
2871 eval { 2898 eval {
2872 BDB::db_env_open 2899 BDB::db_env_open
2873 $DB_ENV, 2900 $DB_ENV,
2874 $BDB_ENV_DIR, 2901 $BDBDIR,
2875 BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN 2902 BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
2876 | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE, 2903 | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
2877 0666; 2904 0666;
2878 2905
2879 cf::cleanup "db_env_open($BDB_ENV_DIR): $!" if $!; 2906 cf::cleanup "db_env_open($BDBDIR): $!" if $!;
2880 2907
2881 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1); 2908 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1);
2882 $DB_ENV->set_lk_detect; 2909 $DB_ENV->set_lk_detect;
2883 }; 2910 };
2884 2911
… …
2900 prio => 6, 2927 prio => 6,
2901 cb => \&IO::AIO::poll_cb, 2928 cb => \&IO::AIO::poll_cb,
2902 ); 2929 );
2903} 2930}
2904 2931
2932my $_log_backtrace;
2933
2934sub _log_backtrace {
2935 my ($msg, @addr) = @_;
2936
2937 $msg =~ s/\n//;
2938
2939 # limit the # of concurrent backtraces
2940 if ($_log_backtrace < 2) {
2941 ++$_log_backtrace;
2942 async {
2943 my @bt = fork_call {
2944 @addr = map { sprintf "%x", $_ } @addr;
2945 my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X;
2946 open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |"
2947 or die "addr2line: $!";
2948
2949 my @funcs;
2950 my @res = <$fh>;
2951 chomp for @res;
2952 while (@res) {
2953 my ($func, $line) = splice @res, 0, 2, ();
2954 push @funcs, "[$func] $line";
2955 }
2956
2957 @funcs
2958 };
2959
2960 LOG llevInfo, "[ABT] $msg\n";
2961 LOG llevInfo, "[ABT] $_\n" for @bt;
2962 --$_log_backtrace;
2963 };
2964 } else {
2965 LOG llevInfo, "[ABT] $msg\n";
2966 LOG llevInfo, "[ABT] [suppressed]\n";
2967 }
2968}
2969
2905# load additional modules 2970# load additional modules
2906use cf::pod; 2971use cf::pod;
2907 2972
2908END { cf::emergency_save } 2973END { cf::emergency_save }
2909 2974

Diff Legend

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