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.448 by root, Fri Sep 19 05:30:23 2008 UTC vs.
Revision 1.457 by root, Wed Oct 1 05:50:19 2008 UTC

… …
66$Storable::canonical = 1; # reduce rsync transfers 66$Storable::canonical = 1; # reduce rsync transfers
67Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 67Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
68 68
69$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 69$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
70 70
71{ 71# make sure c-lzf reinitialises itself
72 # very ugly, but ensure we acquire the storable lock
73
74 sub net_mstore {
75 my $guard = Coro::Storable::guard;
76 &Storable::net_mstore
77 }
78
79 sub mretrieve {
80 my $guard = Coro::Storable::guard;
81 &Storable::mretrieve
82 }
83
84 Compress::LZF::set_serializer "Coro::Storable", "cf::net_mstore", "cf::mretrieve"; 72Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve";
85 Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 73Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
86}
87 74
88sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 75sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
89 76
90our %COMMAND = (); 77our %COMMAND = ();
91our %COMMAND_TIME = (); 78our %COMMAND_TIME = ();
… …
94our %EXTCMD = (); 81our %EXTCMD = ();
95our %EXTICMD = (); 82our %EXTICMD = ();
96our %EXT_CORO = (); # coroutines bound to extensions 83our %EXT_CORO = (); # coroutines bound to extensions
97our %EXT_MAP = (); # pluggable maps 84our %EXT_MAP = (); # pluggable maps
98 85
99our $RELOAD; # number of reloads so far 86our $RELOAD; # number of reloads so far, non-zero while in reload
100our @EVENT; 87our @EVENT;
101 88
102our $CONFDIR = confdir; 89our $CONFDIR = confdir;
103our $DATADIR = datadir; 90our $DATADIR = datadir;
104our $LIBDIR = "$DATADIR/ext"; 91our $LIBDIR = "$DATADIR/ext";
… …
141our $LOAD; # a number between 0 (idle) and 1 (too many objects) 128our $LOAD; # a number between 0 (idle) and 1 (too many objects)
142our $LOADAVG; # same thing, but with alpha-smoothing 129our $LOADAVG; # same thing, but with alpha-smoothing
143our $JITTER; # average jitter 130our $JITTER; # average jitter
144our $TICK_START; # for load detecting purposes 131our $TICK_START; # for load detecting purposes
145 132
133our @POST_INIT;
134
135our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow)
136
146binmode STDOUT; 137binmode STDOUT;
147binmode STDERR; 138binmode STDERR;
148 139
149# read virtual server time, if available 140# read virtual server time, if available
150unless ($RUNTIME || !-e $RUNTIMEFILE) { 141unless ($RUNTIME || !-e $RUNTIMEFILE) {
… …
318our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 309our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
319 310
320sub encode_json($) { $json_coder->encode ($_[0]) } 311sub encode_json($) { $json_coder->encode ($_[0]) }
321sub decode_json($) { $json_coder->decode ($_[0]) } 312sub decode_json($) { $json_coder->decode ($_[0]) }
322 313
314=item cf::post_init { BLOCK }
315
316Execute the given codeblock, I<after> all extensions have been (re-)loaded,
317but I<before> the server starts ticking again.
318
319The cdoeblock will have a single boolean argument to indicate whether this
320is a reload or not.
321
322=cut
323
324sub post_init(&) {
325 push @POST_INIT, shift;
326}
327
323=item cf::lock_wait $string 328=item cf::lock_wait $string
324 329
325Wait until the given lock is available. See cf::lock_acquire. 330Wait until the given lock is available. See cf::lock_acquire.
326 331
327=item my $lock = cf::lock_acquire $string 332=item my $lock = cf::lock_acquire $string
… …
354 return;#d# 359 return;#d#
355 }#d# 360 }#d#
356 361
357 # wait for lock, if any 362 # wait for lock, if any
358 while ($LOCK{$key}) { 363 while ($LOCK{$key}) {
364 #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
359 push @{ $LOCK{$key} }, $Coro::current; 365 push @{ $LOCK{$key} }, $Coro::current;
360 Coro::schedule; 366 Coro::schedule;
361 } 367 }
362} 368}
363 369
… …
1183 } else { 1189 } else {
1184 aio_unlink "$filename.pst"; 1190 aio_unlink "$filename.pst";
1185 } 1191 }
1186 1192
1187 aio_rename "$filename~", $filename; 1193 aio_rename "$filename~", $filename;
1194
1195 $filename =~ s%/[^/]+$%%;
1196 aio_pathsync $filename if $cf::USE_FSYNC;
1188 } else { 1197 } else {
1189 warn "FATAL: $filename~: $!\n"; 1198 warn "FATAL: $filename~: $!\n";
1190 } 1199 }
1191 } else { 1200 } else {
1192 aio_unlink $filename; 1201 aio_unlink $filename;
… …
1285 my ($name, $cb) = @_; 1294 my ($name, $cb) = @_;
1286 1295
1287 $EXTICMD{$name} = $cb; 1296 $EXTICMD{$name} = $cb;
1288} 1297}
1289 1298
1299use File::Glob ();
1300
1290cf::player->attach ( 1301cf::player->attach (
1291 on_command => sub { 1302 on_command => sub {
1292 my ($pl, $name, $params) = @_; 1303 my ($pl, $name, $params) = @_;
1293 1304
1294 my $cb = $COMMAND{$name} 1305 my $cb = $COMMAND{$name}
… …
1325 } 1336 }
1326 1337
1327 cf::override; 1338 cf::override;
1328 }, 1339 },
1329); 1340);
1341
1342# "readahead" all extensions
1343sub cache_extensions {
1344 my $grp = IO::AIO::aio_group;
1345
1346 add $grp IO::AIO::aio_readdir $LIBDIR, sub {
1347 for (grep /\.ext$/, @{$_[0]}) {
1348 add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data;
1349 }
1350 };
1351
1352 $grp
1353}
1330 1354
1331sub load_extensions { 1355sub load_extensions {
1332 cf::sync_job { 1356 cf::sync_job {
1333 my %todo; 1357 my %todo;
1334 1358
… …
1457 1481
1458sub exists($) { 1482sub exists($) {
1459 my ($login) = @_; 1483 my ($login) = @_;
1460 1484
1461 $cf::PLAYER{$login} 1485 $cf::PLAYER{$login}
1462 or cf::sync_job { !aio_stat path $login } 1486 or !aio_stat path $login
1463} 1487}
1464 1488
1465sub find($) { 1489sub find($) {
1466 return $cf::PLAYER{$_[0]} || do { 1490 return $cf::PLAYER{$_[0]} || do {
1467 my $login = $_[0]; 1491 my $login = $_[0];
… …
2784 id => "infobox", 2808 id => "infobox",
2785 title => "Body Parts", 2809 title => "Body Parts",
2786 reply => undef, 2810 reply => undef,
2787 tooltip => "Shows which body parts you posess and are available", 2811 tooltip => "Shows which body parts you posess and are available",
2788 }, 2812 },
2813 "c/skills" => {
2814 id => "infobox",
2815 title => "Skills",
2816 reply => undef,
2817 tooltip => "Shows your experience per skill and item power",
2818 },
2789 "c/uptime" => { 2819 "c/uptime" => {
2790 id => "infobox", 2820 id => "infobox",
2791 title => "Uptime", 2821 title => "Uptime",
2792 reply => undef, 2822 reply => undef,
2793 tooltip => "How long the server has been running since last restart", 2823 tooltip => "How long the server has been running since last restart",
… …
3347 reload_treasures; 3377 reload_treasures;
3348 3378
3349 warn "finished reloading resource files\n"; 3379 warn "finished reloading resource files\n";
3350} 3380}
3351 3381
3352sub init {
3353 my $guard = freeze_mainloop;
3354
3355 evthread_start IO::AIO::poll_fileno;
3356
3357 reload_resources;
3358}
3359
3360sub reload_config { 3382sub reload_config {
3361 open my $fh, "<:utf8", "$CONFDIR/config" 3383 open my $fh, "<:utf8", "$CONFDIR/config"
3362 or return; 3384 or return;
3363 3385
3364 local $/; 3386 local $/;
… …
3396 seek $fh, 0, 0; 3418 seek $fh, 0, 0;
3397 print $fh $$; 3419 print $fh $$;
3398} 3420}
3399 3421
3400sub main { 3422sub main {
3401 atomic; 3423 cf::init_globals; # initialise logging
3424
3425 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3426 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3427 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3428 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3429
3430 cf::init_experience;
3431 cf::init_anim;
3432 cf::init_attackmess;
3433 cf::init_dynamic;
3434 cf::init_block;
3435
3436 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3402 3437
3403 # we must not ever block the main coroutine 3438 # we must not ever block the main coroutine
3404 local $Coro::idle = sub { 3439 local $Coro::idle = sub {
3405 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3440 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3406 (async { 3441 (async {
3407 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3442 $Coro::current->{desc} = "IDLE BUG HANDLER";
3408 EV::loop EV::LOOP_ONESHOT; 3443 EV::loop EV::LOOP_ONESHOT;
3409 })->prio (Coro::PRIO_MAX); 3444 })->prio (Coro::PRIO_MAX);
3410 }; 3445 };
3411 3446
3412 { 3447 evthread_start IO::AIO::poll_fileno;
3413 my $guard = freeze_mainloop; 3448
3449 cf::sync_job {
3450 reload_resources;
3414 reload_config; 3451 reload_config;
3415 db_init; 3452 db_init;
3453
3454 cf::load_settings;
3455 cf::load_materials;
3456 cf::init_uuid;
3457 cf::init_signals;
3458 cf::init_commands;
3459 cf::init_skills;
3460
3461 cf::init_beforeplay;
3462
3463 atomic;
3464
3416 load_extensions; 3465 load_extensions;
3417 3466
3418 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3419 }
3420
3421 utime time, time, $RUNTIMEFILE; 3467 utime time, time, $RUNTIMEFILE;
3422 3468
3423 # no (long-running) fork's whatsoever before this point(!) 3469 # no (long-running) fork's whatsoever before this point(!)
3424 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3470 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3471
3472 (pop @POST_INIT)->(0) while @POST_INIT;
3473 };
3425 3474
3426 EV::loop; 3475 EV::loop;
3427} 3476}
3428 3477
3429############################################################################# 3478#############################################################################
… …
3487 my $uuid = "$LOCALDIR/uuid"; 3536 my $uuid = "$LOCALDIR/uuid";
3488 3537
3489 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644 3538 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3490 or return; 3539 or return;
3491 3540
3492 my $value = uuid_str $uuid_skip + uuid_seq uuid_cur; 3541 my $value = uuid_seq uuid_cur;
3542
3543 unless ($value) {
3544 warn "cowardly refusing to write zero uuid value!\n";
3545 return;
3546 }
3547
3548 my $value = uuid_str $value + $uuid_skip;
3493 $uuid_skip = 0; 3549 $uuid_skip = 0;
3494 3550
3495 (aio_write $fh, 0, (length $value), $value, 0) <= 0 3551 (aio_write $fh, 0, (length $value), $value, 0) <= 0
3496 and return; 3552 and return;
3497 3553
… …
3519} 3575}
3520 3576
3521sub emergency_save() { 3577sub emergency_save() {
3522 my $freeze_guard = cf::freeze_mainloop; 3578 my $freeze_guard = cf::freeze_mainloop;
3523 3579
3524 warn "enter emergency perl save\n"; 3580 warn "emergency_perl_save: enter\n";
3525 3581
3526 cf::sync_job { 3582 cf::sync_job {
3583 # this is a trade-off: we want to be very quick here, so
3584 # save all maps without fsync, and later call a global sync
3585 # (which in turn might be very very slow)
3586 local $USE_FSYNC = 0;
3587
3527 # use a peculiar iteration method to avoid tripping on perl 3588 # use a peculiar iteration method to avoid tripping on perl
3528 # refcount bugs in for. also avoids problems with players 3589 # refcount bugs in for. also avoids problems with players
3529 # and maps saved/destroyed asynchronously. 3590 # and maps saved/destroyed asynchronously.
3530 warn "begin emergency player save\n"; 3591 warn "emergency_perl_save: begin player save\n";
3531 for my $login (keys %cf::PLAYER) { 3592 for my $login (keys %cf::PLAYER) {
3532 my $pl = $cf::PLAYER{$login} or next; 3593 my $pl = $cf::PLAYER{$login} or next;
3533 $pl->valid or next; 3594 $pl->valid or next;
3534 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt 3595 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
3535 $pl->save; 3596 $pl->save;
3536 } 3597 }
3537 warn "end emergency player save\n"; 3598 warn "emergency_perl_save: end player save\n";
3538 3599
3539 warn "begin emergency map save\n"; 3600 warn "emergency_perl_save: begin map save\n";
3540 for my $path (keys %cf::MAP) { 3601 for my $path (keys %cf::MAP) {
3541 my $map = $cf::MAP{$path} or next; 3602 my $map = $cf::MAP{$path} or next;
3542 $map->valid or next; 3603 $map->valid or next;
3543 $map->save; 3604 $map->save;
3544 } 3605 }
3545 warn "end emergency map save\n"; 3606 warn "emergency_perl_save: end map save\n";
3546 3607
3547 warn "begin emergency database checkpoint\n"; 3608 warn "emergency_perl_save: begin database checkpoint\n";
3548 BDB::db_env_txn_checkpoint $DB_ENV; 3609 BDB::db_env_txn_checkpoint $DB_ENV;
3549 warn "end emergency database checkpoint\n"; 3610 warn "emergency_perl_save: end database checkpoint\n";
3550 3611
3551 warn "begin write uuid\n"; 3612 warn "emergency_perl_save: begin write uuid\n";
3552 write_uuid_sync 1; 3613 write_uuid_sync 1;
3553 warn "end write uuid\n"; 3614 warn "emergency_perl_save: end write uuid\n";
3554 }; 3615 };
3555 3616
3617 warn "emergency_perl_save: starting sync()\n";
3618 IO::AIO::aio_sync sub {
3619 warn "emergency_perl_save: finished sync()\n";
3620 };
3621
3556 warn "leave emergency perl save\n"; 3622 warn "emergency_perl_save: leave\n";
3557} 3623}
3558 3624
3559sub post_cleanup { 3625sub post_cleanup {
3560 my ($make_core) = @_; 3626 my ($make_core) = @_;
3561 3627
… …
3587 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3653 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3588 for my $name (keys %$leaf_symtab) { 3654 for my $name (keys %$leaf_symtab) {
3589 _gv_clear *{"$pkg$name"}; 3655 _gv_clear *{"$pkg$name"};
3590# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3656# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3591 } 3657 }
3592 warn "cleared package #$pkg\n";#d# 3658 warn "cleared package $pkg\n";#d#
3593} 3659}
3594
3595our $RELOAD; # how many times to reload
3596 3660
3597sub do_reload_perl() { 3661sub do_reload_perl() {
3598 # can/must only be called in main 3662 # can/must only be called in main
3599 if ($Coro::current != $Coro::main) { 3663 if ($Coro::current != $Coro::main) {
3600 warn "can only reload from main coroutine"; 3664 warn "can only reload from main coroutine";
3601 return; 3665 return;
3602 } 3666 }
3603 3667
3604 return if $RELOAD++; 3668 return if $RELOAD++;
3669
3670 my $t1 = EV::time;
3605 3671
3606 while ($RELOAD) { 3672 while ($RELOAD) {
3607 warn "reloading..."; 3673 warn "reloading...";
3608 3674
3609 warn "entering sync_job"; 3675 warn "entering sync_job";
… …
3688 cf::reload_config; 3754 cf::reload_config;
3689 3755
3690 warn "loading extensions"; 3756 warn "loading extensions";
3691 cf::load_extensions; 3757 cf::load_extensions;
3692 3758
3759 if ($REATTACH_ON_RELOAD) {
3693 warn "reattaching attachments to objects/players"; 3760 warn "reattaching attachments to objects/players";
3694 _global_reattach; # objects, sockets 3761 _global_reattach; # objects, sockets
3695 warn "reattaching attachments to maps"; 3762 warn "reattaching attachments to maps";
3696 reattach $_ for values %MAP; 3763 reattach $_ for values %MAP;
3697 warn "reattaching attachments to players"; 3764 warn "reattaching attachments to players";
3698 reattach $_ for values %PLAYER; 3765 reattach $_ for values %PLAYER;
3766 }
3767
3768 warn "running post_init jobs";
3769 (pop @POST_INIT)->(1) while @POST_INIT;
3699 3770
3700 warn "leaving sync_job"; 3771 warn "leaving sync_job";
3701 3772
3702 1 3773 1
3703 } or do { 3774 } or do {
… …
3706 }; 3777 };
3707 3778
3708 warn "reloaded"; 3779 warn "reloaded";
3709 --$RELOAD; 3780 --$RELOAD;
3710 } 3781 }
3782
3783 $t1 = EV::time - $t1;
3784 warn "reload completed in ${t1}s\n";
3711}; 3785};
3712 3786
3713our $RELOAD_WATCHER; # used only during reload 3787our $RELOAD_WATCHER; # used only during reload
3714 3788
3715sub reload_perl() { 3789sub reload_perl() {
3716 # doing reload synchronously and two reloads happen back-to-back, 3790 # doing reload synchronously and two reloads happen back-to-back,
3717 # coro crashes during coro_state_free->destroy here. 3791 # coro crashes during coro_state_free->destroy here.
3718 3792
3793 $RELOAD_WATCHER ||= cf::async {
3794 Coro::AIO::aio_wait cache_extensions;
3795
3719 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3796 $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub {
3720 do_reload_perl; 3797 do_reload_perl;
3721 undef $RELOAD_WATCHER; 3798 undef $RELOAD_WATCHER;
3799 };
3722 }; 3800 };
3723} 3801}
3724 3802
3725register_command "reload" => sub { 3803register_command "reload" => sub {
3726 my ($who, $arg) = @_; 3804 my ($who, $arg) = @_;

Diff Legend

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