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

Diff Legend

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