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.454 by root, Thu Sep 25 12:14:32 2008 UTC vs.
Revision 1.457 by root, Wed Oct 1 05:50:19 2008 UTC

130our $JITTER; # average jitter 130our $JITTER; # average jitter
131our $TICK_START; # for load detecting purposes 131our $TICK_START; # for load detecting purposes
132 132
133our @POST_INIT; 133our @POST_INIT;
134 134
135our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow)
136
135binmode STDOUT; 137binmode STDOUT;
136binmode STDERR; 138binmode STDERR;
137 139
138# read virtual server time, if available 140# read virtual server time, if available
139unless ($RUNTIME || !-e $RUNTIMEFILE) { 141unless ($RUNTIME || !-e $RUNTIMEFILE) {
1187 } else { 1189 } else {
1188 aio_unlink "$filename.pst"; 1190 aio_unlink "$filename.pst";
1189 } 1191 }
1190 1192
1191 aio_rename "$filename~", $filename; 1193 aio_rename "$filename~", $filename;
1194
1195 $filename =~ s%/[^/]+$%%;
1196 aio_pathsync $filename if $cf::USE_FSYNC;
1192 } else { 1197 } else {
1193 warn "FATAL: $filename~: $!\n"; 1198 warn "FATAL: $filename~: $!\n";
1194 } 1199 }
1195 } else { 1200 } else {
1196 aio_unlink $filename; 1201 aio_unlink $filename;
1289 my ($name, $cb) = @_; 1294 my ($name, $cb) = @_;
1290 1295
1291 $EXTICMD{$name} = $cb; 1296 $EXTICMD{$name} = $cb;
1292} 1297}
1293 1298
1299use File::Glob ();
1300
1294cf::player->attach ( 1301cf::player->attach (
1295 on_command => sub { 1302 on_command => sub {
1296 my ($pl, $name, $params) = @_; 1303 my ($pl, $name, $params) = @_;
1297 1304
1298 my $cb = $COMMAND{$name} 1305 my $cb = $COMMAND{$name}
1329 } 1336 }
1330 1337
1331 cf::override; 1338 cf::override;
1332 }, 1339 },
1333); 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}
1334 1354
1335sub load_extensions { 1355sub load_extensions {
1336 cf::sync_job { 1356 cf::sync_job {
1337 my %todo; 1357 my %todo;
1338 1358
3518 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644 3538 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3519 or return; 3539 or return;
3520 3540
3521 my $value = uuid_seq uuid_cur; 3541 my $value = uuid_seq uuid_cur;
3522 3542
3523 if ($value < 1024) { 3543 unless ($value) {
3524 warn "cowardly refusing to write low uuid value ($value)!\n"; 3544 warn "cowardly refusing to write zero uuid value!\n";
3525 return; 3545 return;
3526 } 3546 }
3527 3547
3528 my $value = uuid_str $value + $uuid_skip; 3548 my $value = uuid_str $value + $uuid_skip;
3529 $uuid_skip = 0; 3549 $uuid_skip = 0;
3555} 3575}
3556 3576
3557sub emergency_save() { 3577sub emergency_save() {
3558 my $freeze_guard = cf::freeze_mainloop; 3578 my $freeze_guard = cf::freeze_mainloop;
3559 3579
3560 warn "enter emergency perl save\n"; 3580 warn "emergency_perl_save: enter\n";
3561 3581
3562 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
3563 # use a peculiar iteration method to avoid tripping on perl 3588 # use a peculiar iteration method to avoid tripping on perl
3564 # refcount bugs in for. also avoids problems with players 3589 # refcount bugs in for. also avoids problems with players
3565 # and maps saved/destroyed asynchronously. 3590 # and maps saved/destroyed asynchronously.
3566 warn "begin emergency player save\n"; 3591 warn "emergency_perl_save: begin player save\n";
3567 for my $login (keys %cf::PLAYER) { 3592 for my $login (keys %cf::PLAYER) {
3568 my $pl = $cf::PLAYER{$login} or next; 3593 my $pl = $cf::PLAYER{$login} or next;
3569 $pl->valid or next; 3594 $pl->valid or next;
3570 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt 3595 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
3571 $pl->save; 3596 $pl->save;
3572 } 3597 }
3573 warn "end emergency player save\n"; 3598 warn "emergency_perl_save: end player save\n";
3574 3599
3575 warn "begin emergency map save\n"; 3600 warn "emergency_perl_save: begin map save\n";
3576 for my $path (keys %cf::MAP) { 3601 for my $path (keys %cf::MAP) {
3577 my $map = $cf::MAP{$path} or next; 3602 my $map = $cf::MAP{$path} or next;
3578 $map->valid or next; 3603 $map->valid or next;
3579 $map->save; 3604 $map->save;
3580 } 3605 }
3581 warn "end emergency map save\n"; 3606 warn "emergency_perl_save: end map save\n";
3582 3607
3583 warn "begin emergency database checkpoint\n"; 3608 warn "emergency_perl_save: begin database checkpoint\n";
3584 BDB::db_env_txn_checkpoint $DB_ENV; 3609 BDB::db_env_txn_checkpoint $DB_ENV;
3585 warn "end emergency database checkpoint\n"; 3610 warn "emergency_perl_save: end database checkpoint\n";
3586 3611
3587 warn "begin write uuid\n"; 3612 warn "emergency_perl_save: begin write uuid\n";
3588 write_uuid_sync 1; 3613 write_uuid_sync 1;
3589 warn "end write uuid\n"; 3614 warn "emergency_perl_save: end write uuid\n";
3590 }; 3615 };
3591 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
3592 warn "leave emergency perl save\n"; 3622 warn "emergency_perl_save: leave\n";
3593} 3623}
3594 3624
3595sub post_cleanup { 3625sub post_cleanup {
3596 my ($make_core) = @_; 3626 my ($make_core) = @_;
3597 3627
3634 warn "can only reload from main coroutine"; 3664 warn "can only reload from main coroutine";
3635 return; 3665 return;
3636 } 3666 }
3637 3667
3638 return if $RELOAD++; 3668 return if $RELOAD++;
3669
3670 my $t1 = EV::time;
3639 3671
3640 while ($RELOAD) { 3672 while ($RELOAD) {
3641 warn "reloading..."; 3673 warn "reloading...";
3642 3674
3643 warn "entering sync_job"; 3675 warn "entering sync_job";
3722 cf::reload_config; 3754 cf::reload_config;
3723 3755
3724 warn "loading extensions"; 3756 warn "loading extensions";
3725 cf::load_extensions; 3757 cf::load_extensions;
3726 3758
3759 if ($REATTACH_ON_RELOAD) {
3727 warn "reattaching attachments to objects/players"; 3760 warn "reattaching attachments to objects/players";
3728 _global_reattach; # objects, sockets 3761 _global_reattach; # objects, sockets
3729 warn "reattaching attachments to maps"; 3762 warn "reattaching attachments to maps";
3730 reattach $_ for values %MAP; 3763 reattach $_ for values %MAP;
3731 warn "reattaching attachments to players"; 3764 warn "reattaching attachments to players";
3732 reattach $_ for values %PLAYER; 3765 reattach $_ for values %PLAYER;
3766 }
3733 3767
3734 warn "running post_load"; 3768 warn "running post_init jobs";
3735 (pop @POST_INIT)->(1) while @POST_INIT; 3769 (pop @POST_INIT)->(1) while @POST_INIT;
3736 3770
3737 warn "leaving sync_job"; 3771 warn "leaving sync_job";
3738 3772
3739 1 3773 1
3743 }; 3777 };
3744 3778
3745 warn "reloaded"; 3779 warn "reloaded";
3746 --$RELOAD; 3780 --$RELOAD;
3747 } 3781 }
3782
3783 $t1 = EV::time - $t1;
3784 warn "reload completed in ${t1}s\n";
3748}; 3785};
3749 3786
3750our $RELOAD_WATCHER; # used only during reload 3787our $RELOAD_WATCHER; # used only during reload
3751 3788
3752sub reload_perl() { 3789sub reload_perl() {
3753 # doing reload synchronously and two reloads happen back-to-back, 3790 # doing reload synchronously and two reloads happen back-to-back,
3754 # coro crashes during coro_state_free->destroy here. 3791 # coro crashes during coro_state_free->destroy here.
3755 3792
3793 $RELOAD_WATCHER ||= cf::async {
3794 Coro::AIO::aio_wait cache_extensions;
3795
3756 $RELOAD_WATCHER ||= EV::timer $TICK * 1.5, 0, sub { 3796 $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub {
3757 do_reload_perl; 3797 do_reload_perl;
3758 undef $RELOAD_WATCHER; 3798 undef $RELOAD_WATCHER;
3799 };
3759 }; 3800 };
3760} 3801}
3761 3802
3762register_command "reload" => sub { 3803register_command "reload" => sub {
3763 my ($who, $arg) = @_; 3804 my ($who, $arg) = @_;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines