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.145 by root, Sun Jan 7 21:54:59 2007 UTC vs.
Revision 1.187 by root, Sat Jan 20 21:06:52 2007 UTC

… …
8use Storable; 8use Storable;
9use Opcode; 9use Opcode;
10use Safe; 10use Safe;
11use Safe::Hole; 11use Safe::Hole;
12 12
13use Coro 3.3 (); 13use Coro 3.4 ();
14use Coro::Event; 14use Coro::Event;
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Data::Dumper;
20use Digest::MD5; 21use Digest::MD5;
21use Fcntl; 22use Fcntl;
22use IO::AIO 2.32 (); 23use IO::AIO 2.32 ();
23use YAML::Syck (); 24use YAML::Syck ();
24use Time::HiRes; 25use Time::HiRes;
25 26
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 27use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 28
29sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
30
28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 31# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29$YAML::Syck::ImplicitUnicode = 1; 32$YAML::Syck::ImplicitUnicode = 1;
30 33
31$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32 35
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34
35our %COMMAND = (); 36our %COMMAND = ();
36our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38
39our @EXTS = (); # list of extension package names
37our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions
42our %EXT_MAP = (); # pluggable maps
38 43
39our @EVENT; 44our @EVENT;
40our $LIBDIR = datadir . "/ext"; 45our $LIBDIR = datadir . "/ext";
41 46
42our $TICK = MAX_TIME * 1e-6; 47our $TICK = MAX_TIME * 1e-6;
43our $TICK_WATCHER; 48our $TICK_WATCHER;
49our $AIO_POLL_WATCHER;
50our $WRITE_RUNTIME_WATCHER;
44our $NEXT_TICK; 51our $NEXT_TICK;
45our $NOW; 52our $NOW;
46 53
47our %CFG; 54our %CFG;
48 55
49our $UPTIME; $UPTIME ||= time; 56our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 57our $RUNTIME;
51 58
52our %PLAYER; # all users 59our %PLAYER; # all users
53our %MAP; # all maps 60our %MAP; # all maps
54our $LINK_MAP; # the special {link} map 61our $LINK_MAP; # the special {link} map, which is always available
55our $RANDOM_MAPS = cf::localdir . "/random"; 62our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO; # coroutines bound to extensions 63
64our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
65our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
66
67# used to convert map paths into valid unix filenames by replacing / by ∕
68our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
57 69
58binmode STDOUT; 70binmode STDOUT;
59binmode STDERR; 71binmode STDERR;
60 72
61# read virtual server time, if available 73# read virtual server time, if available
… …
69mkdir cf::localdir . "/" . cf::playerdir; 81mkdir cf::localdir . "/" . cf::playerdir;
70mkdir cf::localdir . "/" . cf::tmpdir; 82mkdir cf::localdir . "/" . cf::tmpdir;
71mkdir cf::localdir . "/" . cf::uniquedir; 83mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS; 84mkdir $RANDOM_MAPS;
73 85
74# a special map that is always available
75our $LINK_MAP;
76our $EMERGENCY_POSITION; 86our $EMERGENCY_POSITION;
77 87
78############################################################################# 88#############################################################################
79 89
80=head2 GLOBAL VARIABLES 90=head2 GLOBAL VARIABLES
… …
105 115
106=item %cf::CFG 116=item %cf::CFG
107 117
108Configuration for the server, loaded from C</etc/crossfire/config>, or 118Configuration for the server, loaded from C</etc/crossfire/config>, or
109from wherever your confdir points to. 119from wherever your confdir points to.
120
121=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
122
123These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
124or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
125processing has been done. Call C<< ->wait >> on them to maximise the
126window of cpu time available, or simply to synchronise to the server tick.
110 127
111=back 128=back
112 129
113=cut 130=cut
114 131
… …
118 utf8::encode $msg; 135 utf8::encode $msg;
119 136
120 $msg .= "\n" 137 $msg .= "\n"
121 unless $msg =~ /\n$/; 138 unless $msg =~ /\n$/;
122 139
123 LOG llevError, "cfperl: $msg"; 140 LOG llevError, $msg;
124 }; 141 };
125} 142}
126 143
127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 144@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 145@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
146 163
147$Event::DIED = sub { 164$Event::DIED = sub {
148 warn "error in event callback: @_"; 165 warn "error in event callback: @_";
149}; 166};
150 167
151my %ext_pkg;
152my @exts;
153my @hook;
154
155=head2 UTILITY FUNCTIONS 168=head2 UTILITY FUNCTIONS
156 169
157=over 4 170=over 4
158 171
172=item dumpval $ref
173
159=cut 174=cut
175
176sub dumpval {
177 eval {
178 local $SIG{__DIE__};
179 my $d;
180 if (1) {
181 $d = new Data::Dumper([$_[0]], ["*var"]);
182 $d->Terse(1);
183 $d->Indent(2);
184 $d->Quotekeys(0);
185 $d->Useqq(1);
186 #$d->Bless(...);
187 $d->Seen($_[1]) if @_ > 1;
188 $d = $d->Dump();
189 }
190 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
191 $d
192 } || "[unable to dump $_[0]: '$@']";
193}
160 194
161use JSON::Syck (); # TODO# replace by JSON::PC once working 195use JSON::Syck (); # TODO# replace by JSON::PC once working
162 196
163=item $ref = cf::from_json $json 197=item $ref = cf::from_json $json
164 198
… …
225} 259}
226 260
227sub freeze_mainloop { 261sub freeze_mainloop {
228 return unless $TICK_WATCHER->is_active; 262 return unless $TICK_WATCHER->is_active;
229 263
230 my $guard = Coro::guard { $TICK_WATCHER->start }; 264 my $guard = Coro::guard {
265 $TICK_WATCHER->start;
266 $WRITE_RUNTIME_WATCHER->start;
267 };
268 $WRITE_RUNTIME_WATCHER->stop;
231 $TICK_WATCHER->stop; 269 $TICK_WATCHER->stop;
232 $guard 270 $guard
233} 271}
234 272
235=item cf::async { BLOCK } 273=item cf::async { BLOCK }
… …
287 } 325 }
288} 326}
289 327
290=item $coro = cf::async_ext { BLOCK } 328=item $coro = cf::async_ext { BLOCK }
291 329
292Like async, but this coro is automcatially being canceled when the 330Like async, but this coro is automatically being canceled when the
293extension calling this is being unloaded. 331extension calling this is being unloaded.
294 332
295=cut 333=cut
296 334
297sub async_ext(&) { 335sub async_ext(&) {
… …
311 my $runtime = cf::localdir . "/runtime"; 349 my $runtime = cf::localdir . "/runtime";
312 350
313 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 351 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
314 or return; 352 or return;
315 353
354 my $value = $cf::RUNTIME + 90 + 10;
316 my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock 355 # 10 is the runtime save interval, for a monotonic clock
356 # 60 allows for the watchdog to kill the server.
357
317 (aio_write $fh, 0, (length $value), $value, 0) <= 0 358 (aio_write $fh, 0, (length $value), $value, 0) <= 0
318 and return; 359 and return;
319 360
320 aio_fsync $fh 361 aio_fsync $fh
321 and return; 362 and return;
… …
330} 371}
331 372
332=back 373=back
333 374
334=cut 375=cut
335
336#############################################################################
337
338package cf::path;
339
340sub new {
341 my ($class, $path, $base) = @_;
342
343 $path = $path->as_string if ref $path;
344
345 my $self = bless { }, $class;
346
347 # {... are special paths that are not touched
348 # ?xxx/... are special absolute paths
349 # ?random/... random maps
350 # /! non-realised random map exit
351 # /... normal maps
352 # ~/... per-player maps without a specific player (DO NOT USE)
353 # ~user/... per-player map of a specific user
354
355 if ($path =~ /^{/) {
356 # fine as it is
357 } elsif ($path =~ s{^\?random/}{}) {
358 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
359 $self->{random} = cf::from_json $data;
360 } else {
361 if ($path =~ s{^~([^/]+)?}{}) {
362 $self->{user_rel} = 1;
363
364 if (defined $1) {
365 $self->{user} = $1;
366 } elsif ($base =~ m{^~([^/]+)/}) {
367 $self->{user} = $1;
368 } else {
369 warn "cannot resolve user-relative path without user <$path,$base>\n";
370 }
371 } elsif ($path =~ /^\//) {
372 # already absolute
373 } else {
374 $base =~ s{[^/]+/?$}{};
375 return $class->new ("$base/$path");
376 }
377
378 for ($path) {
379 redo if s{/\.?/}{/};
380 redo if s{/[^/]+/\.\./}{/};
381 }
382 }
383
384 $self->{path} = $path;
385
386 $self
387}
388
389# the name / primary key / in-game path
390sub as_string {
391 my ($self) = @_;
392
393 $self->{user_rel} ? "~$self->{user}$self->{path}"
394 : $self->{random} ? "?random/$self->{path}"
395 : $self->{path}
396}
397
398# the displayed name, this is a one way mapping
399sub visible_name {
400 my ($self) = @_;
401
402# if (my $rmp = $self->{random}) {
403# # todo: be more intelligent about this
404# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
405# } else {
406 $self->as_string
407# }
408}
409
410# escape the /'s in the path
411sub _escaped_path {
412 # ∕ is U+2215
413 (my $path = $_[0]{path}) =~ s/\//∕/g;
414 $path
415}
416
417# the original (read-only) location
418sub load_path {
419 my ($self) = @_;
420
421 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
422}
423
424# the temporary/swap location
425sub save_path {
426 my ($self) = @_;
427
428 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
429 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
430 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
431}
432
433# the unique path, might be eq to save_path
434sub uniq_path {
435 my ($self) = @_;
436
437 $self->{user_rel} || $self->{random}
438 ? undef
439 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
440}
441
442# return random map parameters, or undef
443sub random_map_params {
444 my ($self) = @_;
445
446 $self->{random}
447}
448
449# this is somewhat ugly, but style maps do need special treatment
450sub is_style_map {
451 $_[0]{path} =~ m{^/styles/}
452}
453
454package cf;
455 376
456############################################################################# 377#############################################################################
457 378
458=head2 ATTACHABLE OBJECTS 379=head2 ATTACHABLE OBJECTS
459 380
… …
585our @CB_TYPE = (); # registry for type (cf-object class) based events 506our @CB_TYPE = (); # registry for type (cf-object class) based events
586our @CB_MAP = (); 507our @CB_MAP = ();
587 508
588my %attachment; 509my %attachment;
589 510
511sub cf::attachable::thawer_merge {
512 # simply override everything except _meta
513 local $_[0]{_meta};
514 %{$_[0]} = %{$_[1]};
515}
516
590sub _attach_cb($$$$) { 517sub _attach_cb($$$$) {
591 my ($registry, $event, $prio, $cb) = @_; 518 my ($registry, $event, $prio, $cb) = @_;
592 519
593 use sort 'stable'; 520 use sort 'stable';
594 521
… …
765# object support 692# object support
766 693
767sub reattach { 694sub reattach {
768 # basically do the same as instantiate, without calling instantiate 695 # basically do the same as instantiate, without calling instantiate
769 my ($obj) = @_; 696 my ($obj) = @_;
697
698 bless $obj, ref $obj; # re-bless in case extensions have been reloaded
770 699
771 my $registry = $obj->registry; 700 my $registry = $obj->registry;
772 701
773 @$registry = (); 702 @$registry = ();
774 703
… …
906=cut 835=cut
907 836
908sub register_extcmd { 837sub register_extcmd {
909 my ($name, $cb) = @_; 838 my ($name, $cb) = @_;
910 839
911 my $caller = caller;
912 #warn "registering extcmd '$name' to '$caller'";
913
914 $EXTCMD{$name} = [$cb, $caller]; 840 $EXTCMD{$name} = $cb;
915} 841}
916 842
917cf::player->attach ( 843cf::player->attach (
918 on_command => sub { 844 on_command => sub {
919 my ($pl, $name, $params) = @_; 845 my ($pl, $name, $params) = @_;
… …
932 858
933 my $msg = eval { from_json $buf }; 859 my $msg = eval { from_json $buf };
934 860
935 if (ref $msg) { 861 if (ref $msg) {
936 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 862 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
937 if (my %reply = $cb->[0]->($pl, $msg)) { 863 if (my %reply = $cb->($pl, $msg)) {
938 $pl->ext_reply ($msg->{msgid}, %reply); 864 $pl->ext_reply ($msg->{msgid}, %reply);
939 } 865 }
940 } 866 }
941 } else { 867 } else {
942 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 868 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
944 870
945 cf::override; 871 cf::override;
946 }, 872 },
947); 873);
948 874
949sub register {
950 my ($base, $pkg) = @_;
951
952 #TODO
953}
954
955sub load_extension { 875sub load_extension {
956 my ($path) = @_; 876 my ($path) = @_;
957 877
958 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 878 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
959 my $base = $1; 879 my $base = $1;
960 my $pkg = $1; 880 my $pkg = $1;
961 $pkg =~ s/[^[:word:]]/_/g; 881 $pkg =~ s/[^[:word:]]/_/g;
962 $pkg = "ext::$pkg"; 882 $pkg = "ext::$pkg";
963 883
964 warn "loading '$path' into '$pkg'\n"; 884 warn "... loading '$path' into '$pkg'\n";
965 885
966 open my $fh, "<:utf8", $path 886 open my $fh, "<:utf8", $path
967 or die "$path: $!"; 887 or die "$path: $!";
968 888
969 my $source = 889 my $source =
970 "package $pkg; use strict; use utf8;\n" 890 "package $pkg; use strict; use utf8;\n"
971 . "#line 1 \"$path\"\n{\n" 891 . "#line 1 \"$path\"\n{\n"
972 . (do { local $/; <$fh> }) 892 . (do { local $/; <$fh> })
973 . "\n};\n1"; 893 . "\n};\n1";
974 894
975 eval $source 895 unless (eval $source) {
976 or die $@ ? "$path: $@\n" 896 my $msg = $@ ? "$path: $@\n"
977 : "extension disabled.\n"; 897 : "extension disabled.\n";
978 898 if ($source =~ /^#!.*perl.*#.*MANDATORY/m) { # ugly match
979 push @exts, $pkg; 899 warn $@;
980 $ext_pkg{$base} = $pkg; 900 warn "mandatory extension failed to load, exiting.\n";
981 901 exit 1;
982# no strict 'refs'; 902 }
983# @{"$pkg\::ISA"} = ext::; 903 die $@;
984
985 register $base, $pkg;
986}
987
988sub unload_extension {
989 my ($pkg) = @_;
990
991 warn "removing extension $pkg\n";
992
993 # remove hooks
994 #TODO
995# for my $idx (0 .. $#PLUGIN_EVENT) {
996# delete $hook[$idx]{$pkg};
997# } 904 }
998 905
999 # remove commands 906 push @EXTS, $pkg;
1000 for my $name (keys %COMMAND) {
1001 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1002
1003 if (@cb) {
1004 $COMMAND{$name} = \@cb;
1005 } else {
1006 delete $COMMAND{$name};
1007 }
1008 }
1009
1010 # remove extcmds
1011 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1012 delete $EXTCMD{$name};
1013 }
1014
1015 if (my $cb = $pkg->can ("unload")) {
1016 eval {
1017 $cb->($pkg);
1018 1
1019 } or warn "$pkg unloaded, but with errors: $@";
1020 }
1021
1022 Symbol::delete_package $pkg;
1023} 907}
1024 908
1025sub load_extensions { 909sub load_extensions {
1026 for my $ext (<$LIBDIR/*.ext>) { 910 for my $ext (<$LIBDIR/*.ext>) {
1027 next unless -r $ext; 911 next unless -r $ext;
… …
1031 } or warn "$ext not loaded: $@"; 915 } or warn "$ext not loaded: $@";
1032 } 916 }
1033} 917}
1034 918
1035############################################################################# 919#############################################################################
1036# load/save/clean perl data associated with a map
1037
1038*cf::mapsupport::on_clean = sub {
1039 my ($map) = @_;
1040
1041 my $path = $map->tmpname;
1042 defined $path or return;
1043
1044 unlink "$path.pst";
1045};
1046
1047cf::map->attach (prio => -10000, package => cf::mapsupport::);
1048
1049#############################################################################
1050# load/save perl data associated with player->ob objects
1051
1052sub all_objects(@) {
1053 @_, map all_objects ($_->inv), @_
1054}
1055
1056# TODO: compatibility cruft, remove when no longer needed
1057cf::player->attach (
1058 on_load => sub {
1059 my ($pl, $path) = @_;
1060
1061 for my $o (all_objects $pl->ob) {
1062 if (my $value = $o->get_ob_key_value ("_perl_data")) {
1063 $o->set_ob_key_value ("_perl_data");
1064
1065 %$o = %{ Storable::thaw pack "H*", $value };
1066 }
1067 }
1068 },
1069);
1070
1071#############################################################################
1072 920
1073=head2 CORE EXTENSIONS 921=head2 CORE EXTENSIONS
1074 922
1075Functions and methods that extend core crossfire objects. 923Functions and methods that extend core crossfire objects.
1076 924
1077=cut 925=cut
1078 926
1079package cf::player; 927package cf::player;
928
929use Coro::AIO;
1080 930
1081=head3 cf::player 931=head3 cf::player
1082 932
1083=over 4 933=over 4
1084 934
… …
1110 960
1111sub exists($) { 961sub exists($) {
1112 my ($login) = @_; 962 my ($login) = @_;
1113 963
1114 $cf::PLAYER{$login} 964 $cf::PLAYER{$login}
1115 or cf::sync_job { !aio_stat $login } 965 or cf::sync_job { !aio_stat path $login }
1116} 966}
1117 967
1118sub find($) { 968sub find($) {
1119 return $cf::PLAYER{$_[0]} || do { 969 return $cf::PLAYER{$_[0]} || do {
1120 my $login = $_[0]; 970 my $login = $_[0];
1121 971
1122 my $guard = cf::lock_acquire "user_find:$login"; 972 my $guard = cf::lock_acquire "user_find:$login";
1123 973
1124 $cf::PLAYER{$login} ||= (load_pl path $login or return); 974 $cf::PLAYER{$_[0]} || do {
975 my $pl = load_pl path $login
976 or return;
977 $cf::PLAYER{$login} = $pl
978 }
1125 }; 979 }
1126} 980}
1127 981
1128sub save($) { 982sub save($) {
1129 my ($pl) = @_; 983 my ($pl) = @_;
1130 984
… …
1132 986
1133 my $path = path $pl; 987 my $path = path $pl;
1134 my $guard = cf::lock_acquire "user_save:$path"; 988 my $guard = cf::lock_acquire "user_save:$path";
1135 989
1136 return if $pl->{deny_save}; 990 return if $pl->{deny_save};
991
992 aio_mkdir playerdir $pl, 0770;
1137 $pl->{last_save} = $cf::RUNTIME; 993 $pl->{last_save} = $cf::RUNTIME;
1138 994
1139 Coro::cede;
1140 $pl->save_pl ($path); 995 $pl->save_pl ($path);
1141 Coro::cede; 996 Coro::cede;
1142} 997}
1143 998
1144sub new($) { 999sub new($) {
… …
1151 1006
1152 $cf::PLAYER{$login} = $self; 1007 $cf::PLAYER{$login} = $self;
1153 1008
1154 $self 1009 $self
1155} 1010}
1011
1012=item $pl->quit_character
1013
1014Nukes the player without looking back. If logged in, the connection will
1015be destroyed. May block for a long time.
1016
1017=cut
1156 1018
1157sub quit_character { 1019sub quit_character {
1158 my ($pl) = @_; 1020 my ($pl) = @_;
1159 1021
1160 $pl->{deny_save} = 1; 1022 $pl->{deny_save} = 1;
… …
1165 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1027 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1166 $pl->ns->destroy if $pl->ns; 1028 $pl->ns->destroy if $pl->ns;
1167 1029
1168 my $path = playerdir $pl; 1030 my $path = playerdir $pl;
1169 my $temp = "$path~$cf::RUNTIME~deleting~"; 1031 my $temp = "$path~$cf::RUNTIME~deleting~";
1170 IO::AIO::aio_rename $path, $temp, sub { 1032 aio_rename $path, $temp;
1171 delete $cf::PLAYER{$pl->ob->name}; 1033 delete $cf::PLAYER{$pl->ob->name};
1172 $pl->destroy; 1034 $pl->destroy;
1173
1174 IO::AIO::aio_rmtree $temp; 1035 IO::AIO::aio_rmtree $temp;
1036}
1037
1038=item cf::player::list_logins
1039
1040Returns am arrayref of all valid playernames in the system, can take a
1041while and may block, so not sync_job-capable, ever.
1042
1043=cut
1044
1045sub list_logins {
1046 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
1047 or return [];
1048
1049 my @logins;
1050
1051 for my $login (@$dirs) {
1052 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1053 aio_read $fh, 0, 512, my $buf, 0 or next;
1054 $buf !~ /^password -------------$/m or next; # official not-valid tag
1055
1056 utf8::decode $login;
1057 push @logins, $login;
1175 }; 1058 }
1059
1060 \@logins
1061}
1062
1063=item $player->maps
1064
1065Returns an arrayref of map paths that are private for this
1066player. May block.
1067
1068=cut
1069
1070sub maps($) {
1071 my ($pl) = @_;
1072
1073 my $files = aio_readdir playerdir $pl
1074 or return;
1075
1076 my @paths;
1077
1078 for (@$files) {
1079 utf8::decode $_;
1080 next if /\.(?:pl|pst)$/;
1081 next unless /^$PATH_SEP/o;
1082
1083 s/\.map$//;
1084 push @paths, "~" . $pl->ob->name . "/" . $_;
1085 }
1086
1087 \@paths
1176} 1088}
1177 1089
1178=item $player->ext_reply ($msgid, $msgtype, %msg) 1090=item $player->ext_reply ($msgid, $msgtype, %msg)
1179 1091
1180Sends an ext reply to the player. 1092Sends an ext reply to the player.
… …
1203package cf::map; 1115package cf::map;
1204 1116
1205use Fcntl; 1117use Fcntl;
1206use Coro::AIO; 1118use Coro::AIO;
1207 1119
1120use overload
1121 '""' => \&as_string,
1122 fallback => 1;
1123
1208our $MAX_RESET = 3600; 1124our $MAX_RESET = 3600;
1209our $DEFAULT_RESET = 3000; 1125our $DEFAULT_RESET = 3000;
1210 1126
1211sub generate_random_map { 1127sub generate_random_map {
1212 my ($path, $rmp) = @_; 1128 my ($self, $rmp) = @_;
1213
1214 # mit "rum" bekleckern, nicht 1129 # mit "rum" bekleckern, nicht
1215 cf::map::_create_random_map 1130 $self->_create_random_map (
1216 $path,
1217 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1131 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1218 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1132 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1219 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1133 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1220 $rmp->{exit_on_final_map}, 1134 $rmp->{exit_on_final_map},
1221 $rmp->{xsize}, $rmp->{ysize}, 1135 $rmp->{xsize}, $rmp->{ysize},
1222 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1136 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1223 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1137 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1224 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation}, 1138 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1225 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp}, 1139 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1226 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used}, 1140 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1227 (cf::region::find $rmp->{region}) 1141 (cf::region::find $rmp->{region}), $rmp->{custom}
1142 )
1143}
1144
1145=item cf::map->register ($regex, $prio)
1146
1147Register a handler for the map path matching the given regex at the
1148givne priority (higher is better, built-in handlers have priority 0, the
1149default).
1150
1151=cut
1152
1153sub register {
1154 my (undef, $regex, $prio) = @_;
1155 my $pkg = caller;
1156
1157 no strict;
1158 push @{"$pkg\::ISA"}, __PACKAGE__;
1159
1160 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1161}
1162
1163# also paths starting with '/'
1164$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}];
1165
1166sub thawer_merge {
1167 my ($self, $merge) = @_;
1168
1169 # we have to keep some variables in memory intact
1170 local $self->{path};
1171 local $self->{load_path};
1172 local $self->{deny_save};
1173 local $self->{deny_reset};
1174
1175 $self->SUPER::thawer_merge ($merge);
1176}
1177
1178sub normalise {
1179 my ($path, $base) = @_;
1180
1181 # map plan:
1182 #
1183 # /! non-realised random map exit (special hack!)
1184 # {... are special paths that are not being touched
1185 # ?xxx/... are special absolute paths
1186 # ?random/... random maps
1187 # /... normal maps
1188 # ~user/... per-player map of a specific user
1189
1190 $path =~ s/$PATH_SEP/\//go;
1191
1192 # treat it as relative path if it starts with
1193 # something that looks reasonable
1194 if ($path =~ m{^(?:\./|\.\./|\w)}) {
1195 $base or Carp::carp "normalise called with relative path and no base: '$path'";
1196
1197 $base =~ s{[^/]+/?$}{};
1198 $path = "$base/$path";
1199 }
1200
1201 for ($path) {
1202 redo if s{//}{/};
1203 redo if s{/\.?/}{/};
1204 redo if s{/[^/]+/\.\./}{/};
1205 }
1206
1207 $path
1208}
1209
1210sub new_from_path {
1211 my (undef, $path, $base) = @_;
1212
1213 return $path if UNIVERSAL::isa $path, "cf::map"; # already a map object
1214
1215 $path = normalise $path, $base;
1216
1217 for my $pkg (sort { $EXT_MAP{$b}[0] <=> $EXT_MAP{$a}[0] } keys %EXT_MAP) {
1218 if ($path =~ $EXT_MAP{$pkg}[1]) {
1219 my $self = bless cf::map::new, $pkg;
1220 $self->{path} = $path; $self->path ($path);
1221 $self->init; # pass $1 etc.
1222 return $self;
1223 }
1224 }
1225
1226 Carp::carp "unable to resolve path '$path'.";
1227 ()
1228}
1229
1230sub init {
1231 my ($self) = @_;
1232
1233 $self
1234}
1235
1236sub as_string {
1237 my ($self) = @_;
1238
1239 "$self->{path}"
1240}
1241
1242# the displayed name, this is a one way mapping
1243sub visible_name {
1244 &as_string
1245}
1246
1247# the original (read-only) location
1248sub load_path {
1249 my ($self) = @_;
1250
1251 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
1252}
1253
1254# the temporary/swap location
1255sub save_path {
1256 my ($self) = @_;
1257
1258 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1259 sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $path
1260}
1261
1262# the unique path, undef == no special unique path
1263sub uniq_path {
1264 my ($self) = @_;
1265
1266 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1267 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $path
1228} 1268}
1229 1269
1230# and all this just because we cannot iterate over 1270# and all this just because we cannot iterate over
1231# all maps in C++... 1271# all maps in C++...
1232sub change_all_map_light { 1272sub change_all_map_light {
… …
1234 1274
1235 $_->change_map_light ($change) 1275 $_->change_map_light ($change)
1236 for grep $_->outdoor, values %cf::MAP; 1276 for grep $_->outdoor, values %cf::MAP;
1237} 1277}
1238 1278
1279sub unlink_save {
1280 my ($self) = @_;
1281
1282 utf8::encode (my $save = $self->save_path);
1283 IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink $save;
1284 IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink "$save.pst";
1285}
1286
1239sub try_load_header($) { 1287sub load_header_from($) {
1240 my ($path) = @_; 1288 my ($self, $path) = @_;
1241 1289
1242 utf8::encode $path; 1290 utf8::encode $path;
1243 aio_open $path, O_RDONLY, 0 1291 aio_open $path, O_RDONLY, 0
1244 or return; 1292 or return;
1245 1293
1246 my $map = cf::map::new 1294 $self->_load_header ($path)
1247 or return; 1295 or return;
1248 1296
1249 # for better error messages only, will be overwritten 1297 $self->{load_path} = $path;
1250 $map->path ($path);
1251 1298
1252 $map->load_header ($path) 1299 1
1300}
1301
1302sub load_orig {
1303 my ($self) = @_;
1304
1305 $self->load_header_from ($self->load_path)
1306}
1307
1308sub load_temp {
1309 my ($self) = @_;
1310
1311 $self->load_header_from ($self->save_path)
1312}
1313
1314sub load_header {
1315 my ($self) = @_;
1316
1317 if ($self->load_temp) {
1318 $self->last_access ((delete $self->{last_access})
1319 || $cf::RUNTIME); #d#
1320 # safety
1321 $self->{instantiate_time} = $cf::RUNTIME
1322 if $self->{instantiate_time} > $cf::RUNTIME;
1323 } else {
1324 $self->load_orig
1253 or return; 1325 or return;
1254 1326
1255 $map->{load_path} = $path; 1327 $self->{load_original} = 1;
1328 $self->{instantiate_time} = $cf::RUNTIME;
1329 $self->last_access ($cf::RUNTIME);
1330 $self->instantiate;
1331 }
1256 1332
1257 $map 1333 1
1258} 1334}
1259 1335
1260sub find; 1336sub find;
1261sub find { 1337sub find {
1262 my ($path, $origin) = @_; 1338 my ($path, $origin) = @_;
1263 1339
1264 #warn "find<$path,$origin>\n";#d#
1265
1266 $path = new cf::path $path, $origin && $origin->path; 1340 $path = normalise $path, $origin && $origin->path;
1267 my $key = $path->as_string;
1268 1341
1269 cf::lock_wait "map_find:$key"; 1342 cf::lock_wait "map_find:$path";
1270 1343
1271 $cf::MAP{$key} || do { 1344 $cf::MAP{$path} || do {
1272 my $guard = cf::lock_acquire "map_find:$key"; 1345 my $guard = cf::lock_acquire "map_find:$path";
1273 1346 my $map = new_from_path cf::map $path
1274 # do it the slow way
1275 my $map = try_load_header $path->save_path;
1276
1277 Coro::cede;
1278
1279 if ($map) {
1280 $map->last_access ((delete $map->{last_access})
1281 || $cf::RUNTIME); #d#
1282 # safety
1283 $map->{instantiate_time} = $cf::RUNTIME
1284 if $map->{instantiate_time} > $cf::RUNTIME;
1285 } else {
1286 if (my $rmp = $path->random_map_params) {
1287 $map = generate_random_map $key, $rmp;
1288 } else {
1289 $map = try_load_header $path->load_path;
1290 }
1291
1292 $map or return; 1347 or return;
1293 1348
1294 $map->{load_original} = 1;
1295 $map->{instantiate_time} = $cf::RUNTIME;
1296 $map->last_access ($cf::RUNTIME);
1297 $map->instantiate;
1298
1299 # per-player maps become, after loading, normal maps
1300 $map->per_player (0) if $path->{user_rel};
1301 }
1302
1303 $map->path ($key);
1304 $map->{path} = $path;
1305 $map->{last_save} = $cf::RUNTIME; 1349 $map->{last_save} = $cf::RUNTIME;
1306 1350
1307 Coro::cede; 1351 $map->load_header
1352 or return;
1308 1353
1309 if ($map->should_reset) { 1354 if ($map->should_reset) {
1355 # doing this can freeze the server in a sync job, obviously
1356 #$cf::WAIT_FOR_TICK->wait;
1310 $map->reset; 1357 $map->reset;
1311 undef $guard; 1358 undef $guard;
1312 $map = find $path 1359 $map = find $path
1313 or return; 1360 or return;
1314 } 1361 }
1315 1362
1316 $cf::MAP{$key} = $map 1363 $cf::MAP{$path} = $map
1317 } 1364 }
1318} 1365}
1319 1366
1320sub load { 1367sub load {
1321 my ($self) = @_; 1368 my ($self) = @_;
1322 1369
1323 my $path = $self->{path}; 1370 my $path = $self->{path};
1324 my $guard = cf::lock_acquire "map_load:" . $path->as_string; 1371 my $guard = cf::lock_acquire "map_load:$path";
1325 1372
1326 return if $self->in_memory != cf::MAP_SWAPPED; 1373 return if $self->in_memory != cf::MAP_SWAPPED;
1327 1374
1328 $self->in_memory (cf::MAP_LOADING); 1375 $self->in_memory (cf::MAP_LOADING);
1329 1376
1330 $self->alloc; 1377 $self->alloc;
1331 $self->load_objects ($self->{load_path}, 1) 1378 $self->_load_objects ($self->{load_path}, 1)
1332 or return; 1379 or return;
1333 1380
1334 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) 1381 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1335 if delete $self->{load_original}; 1382 if delete $self->{load_original};
1336 1383
1337 if (my $uniq = $path->uniq_path) { 1384 if (my $uniq = $self->uniq_path) {
1338 utf8::encode $uniq; 1385 utf8::encode $uniq;
1339 if (aio_open $uniq, O_RDONLY, 0) { 1386 if (aio_open $uniq, O_RDONLY, 0) {
1340 $self->clear_unique_items; 1387 $self->clear_unique_items;
1341 $self->load_objects ($uniq, 0); 1388 $self->_load_objects ($uniq, 0);
1342 } 1389 }
1343 } 1390 }
1344 1391
1345 Coro::cede; 1392 Coro::cede;
1346 1393
1347 # now do the right thing for maps 1394 # now do the right thing for maps
1348 $self->link_multipart_objects; 1395 $self->link_multipart_objects;
1349 1396
1350 if ($self->{path}->is_style_map) { 1397 unless ($self->{deny_activate}) {
1351 $self->{deny_save} = 1; 1398 $self->decay_objects;
1352 $self->{deny_reset} = 1;
1353 } else {
1354 $self->fix_auto_apply; 1399 $self->fix_auto_apply;
1355 $self->decay_objects;
1356 $self->update_buttons; 1400 $self->update_buttons;
1401 Coro::cede;
1357 $self->set_darkness_map; 1402 $self->set_darkness_map;
1358 $self->difficulty ($self->estimate_difficulty) 1403 $self->difficulty ($self->estimate_difficulty)
1359 unless $self->difficulty; 1404 unless $self->difficulty;
1405 Coro::cede;
1360 $self->activate; 1406 $self->activate;
1361 } 1407 }
1362 1408
1363 Coro::cede;
1364
1365 $self->in_memory (cf::MAP_IN_MEMORY); 1409 $self->in_memory (cf::MAP_IN_MEMORY);
1410}
1411
1412sub customise_for {
1413 my ($self, $ob) = @_;
1414
1415 return find "~" . $ob->name . "/" . $self->{path}
1416 if $self->per_player;
1417
1418 $self
1419}
1420
1421# find and load all maps in the 3x3 area around a map
1422sub load_diag {
1423 my ($map) = @_;
1424
1425 my @diag; # diagonal neighbours
1426
1427 for (0 .. 3) {
1428 my $neigh = $map->tile_path ($_)
1429 or next;
1430 $neigh = find $neigh, $map
1431 or next;
1432 $neigh->load;
1433
1434 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1435 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1436 }
1437
1438 for (@diag) {
1439 my $neigh = find @$_
1440 or next;
1441 $neigh->load;
1442 }
1366} 1443}
1367 1444
1368sub find_sync { 1445sub find_sync {
1369 my ($path, $origin) = @_; 1446 my ($path, $origin) = @_;
1370 1447
1371 cf::sync_job { cf::map::find $path, $origin } 1448 cf::sync_job { find $path, $origin }
1372} 1449}
1373 1450
1374sub do_load_sync { 1451sub do_load_sync {
1375 my ($map) = @_; 1452 my ($map) = @_;
1376 1453
1377 cf::sync_job { $map->load }; 1454 cf::sync_job { $map->load };
1378} 1455}
1379 1456
1457our %MAP_PREFETCH;
1458our $MAP_PREFETCHER = undef;
1459
1460sub find_async {
1461 my ($path, $origin) = @_;
1462
1463 $path = normalise $path, $origin && $origin->{path};
1464
1465 if (my $map = $cf::MAP{$path}) {
1466 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1467 }
1468
1469 undef $MAP_PREFETCH{$path};
1470 $MAP_PREFETCHER ||= cf::async {
1471 while (%MAP_PREFETCH) {
1472 for my $path (keys %MAP_PREFETCH) {
1473 my $map = find $path
1474 or next;
1475 $map->load;
1476
1477 delete $MAP_PREFETCH{$path};
1478 }
1479 }
1480 undef $MAP_PREFETCHER;
1481 };
1482
1483 ()
1484}
1485
1380sub save { 1486sub save {
1381 my ($self) = @_; 1487 my ($self) = @_;
1382 1488
1383 my $lock = cf::lock_acquire "map_data:" . $self->path; 1489 my $lock = cf::lock_acquire "map_data:" . $self->path;
1384 1490
1385 $self->{last_save} = $cf::RUNTIME; 1491 $self->{last_save} = $cf::RUNTIME;
1386 1492
1387 return unless $self->dirty; 1493 return unless $self->dirty;
1388 1494
1389 my $save = $self->{path}->save_path; utf8::encode $save; 1495 my $save = $self->save_path; utf8::encode $save;
1390 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq; 1496 my $uniq = $self->uniq_path; utf8::encode $uniq;
1391 1497
1392 $self->{load_path} = $save; 1498 $self->{load_path} = $save;
1393 1499
1394 return if $self->{deny_save}; 1500 return if $self->{deny_save};
1395 1501
… …
1398 cf::async { 1504 cf::async {
1399 $_->contr->save for $self->players; 1505 $_->contr->save for $self->players;
1400 }; 1506 };
1401 1507
1402 if ($uniq) { 1508 if ($uniq) {
1403 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1509 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1404 $self->save_objects ($uniq, cf::IO_UNIQUES); 1510 $self->_save_objects ($uniq, cf::IO_UNIQUES);
1405 } else { 1511 } else {
1406 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1512 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1407 } 1513 }
1408} 1514}
1409 1515
1410sub swap_out { 1516sub swap_out {
1411 my ($self) = @_; 1517 my ($self) = @_;
… …
1425 1531
1426sub reset_at { 1532sub reset_at {
1427 my ($self) = @_; 1533 my ($self) = @_;
1428 1534
1429 # TODO: safety, remove and allow resettable per-player maps 1535 # TODO: safety, remove and allow resettable per-player maps
1430 return 1e99 if $self->{path}{user_rel}; 1536 return 1e99 if $self->isa ("ext::map_per_player");#d#
1431 return 1e99 if $self->{deny_reset}; 1537 return 1e99 if $self->{deny_reset};
1432 1538
1433 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access; 1539 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1434 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET; 1540 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1435 1541
… …
1440 my ($self) = @_; 1546 my ($self) = @_;
1441 1547
1442 $self->reset_at <= $cf::RUNTIME 1548 $self->reset_at <= $cf::RUNTIME
1443} 1549}
1444 1550
1445sub unlink_save {
1446 my ($self) = @_;
1447
1448 utf8::encode (my $save = $self->{path}->save_path);
1449 aioreq_pri 3; IO::AIO::aio_unlink $save;
1450 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1451}
1452
1453sub rename {
1454 my ($self, $new_path) = @_;
1455
1456 $self->unlink_save;
1457
1458 delete $cf::MAP{$self->path};
1459 $self->{path} = new cf::path $new_path;
1460 $self->path ($self->{path}->as_string);
1461 $cf::MAP{$self->path} = $self;
1462
1463 $self->save;
1464}
1465
1466sub reset { 1551sub reset {
1467 my ($self) = @_; 1552 my ($self) = @_;
1468 1553
1469 my $lock = cf::lock_acquire "map_data:" . $self->path; 1554 my $lock = cf::lock_acquire "map_data:$self->{path}";
1470 1555
1471 return if $self->players; 1556 return if $self->players;
1472 return if $self->{path}{user_rel};#d# 1557 return if $self->isa ("ext::map_per_player");#d#
1473 1558
1474 warn "resetting map ", $self->path;#d# 1559 warn "resetting map ", $self->path;#d#
1475 1560
1476 delete $cf::MAP{$self->path}; 1561 delete $cf::MAP{$self->path};
1562
1563 $self->in_memory (cf::MAP_SWAPPED);
1564 $self->clear;
1477 1565
1478 $_->clear_links_to ($self) for values %cf::MAP; 1566 $_->clear_links_to ($self) for values %cf::MAP;
1479 1567
1480 $self->unlink_save; 1568 $self->unlink_save;
1481 $self->destroy; 1569 $self->destroy;
… …
1484my $nuke_counter = "aaaa"; 1572my $nuke_counter = "aaaa";
1485 1573
1486sub nuke { 1574sub nuke {
1487 my ($self) = @_; 1575 my ($self) = @_;
1488 1576
1577 delete $cf::MAP{$self->path};
1578
1579 $self->unlink_save;
1580
1581 bless $self, "cf::map";
1582 delete $self->{deny_reset};
1489 $self->{deny_save} = 1; 1583 $self->{deny_save} = 1;
1490 $self->reset_timeout (1); 1584 $self->reset_timeout (1);
1491 $self->rename ("{nuke}/" . ($nuke_counter++)); 1585 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
1586
1587 $cf::MAP{$self->path} = $self;
1588
1492 $self->reset; # polite request, might not happen 1589 $self->reset; # polite request, might not happen
1493} 1590}
1494 1591
1495sub customise_for { 1592=item cf::map::unique_maps
1496 my ($map, $ob) = @_;
1497 1593
1498 if ($map->per_player) { 1594Returns an arrayref of paths of all shared maps that have
1499 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path}; 1595instantiated unique items. May block.
1500 }
1501 1596
1502 $map 1597=cut
1503}
1504 1598
1505sub emergency_save { 1599sub unique_maps() {
1506 my $freeze_guard = cf::freeze_mainloop; 1600 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1601 or return;
1507 1602
1508 warn "enter emergency perl save\n"; 1603 my @paths;
1509 1604
1510 cf::sync_job { 1605 for (@$files) {
1511 warn "begin emergency player save\n"; 1606 utf8::decode $_;
1512 $_->save for values %cf::PLAYER; 1607 next if /\.pst$/;
1513 warn "end emergency player save\n"; 1608 next unless /^$PATH_SEP/o;
1514 1609
1515 warn "begin emergency map save\n"; 1610 s/\.map$//;
1516 $_->save for values %cf::MAP; 1611 push @paths, $_;
1517 warn "end emergency map save\n";
1518 }; 1612 }
1519 1613
1520 warn "leave emergency perl save\n"; 1614 \@paths
1521} 1615}
1522 1616
1523package cf; 1617package cf;
1524 1618
1525=back 1619=back
1526 1620
1621=head3 cf::object
1622
1623=cut
1624
1625package cf::object;
1626
1627=over 4
1628
1629=item $ob->inv_recursive
1630
1631Returns the inventory of the object _and_ their inventories, recursively.
1632
1633=cut
1634
1635sub inv_recursive_;
1636sub inv_recursive_ {
1637 map { $_, inv_recursive_ $_->inv } @_
1638}
1639
1640sub inv_recursive {
1641 inv_recursive_ inv $_[0]
1642}
1643
1644package cf;
1645
1646=back
1527 1647
1528=head3 cf::object::player 1648=head3 cf::object::player
1529 1649
1530=over 4 1650=over 4
1531 1651
… …
1571 1691
1572=item $player_object->enter_link 1692=item $player_object->enter_link
1573 1693
1574Freezes the player and moves him/her to a special map (C<{link}>). 1694Freezes the player and moves him/her to a special map (C<{link}>).
1575 1695
1576The player should be reaosnably safe there for short amounts of time. You 1696The player should be reasonably safe there for short amounts of time. You
1577I<MUST> call C<leave_link> as soon as possible, though. 1697I<MUST> call C<leave_link> as soon as possible, though.
1578 1698
1699Will never block.
1700
1579=item $player_object->leave_link ($map, $x, $y) 1701=item $player_object->leave_link ($map, $x, $y)
1580 1702
1581Moves the player out of the specila link map onto the given map. If the 1703Moves the player out of the special C<{link}> map onto the specified
1582map is not valid (or omitted), the player will be moved back to the 1704map. If the map is not valid (or omitted), the player will be moved back
1583location he/she was before the call to C<enter_link>, or, if that fails, 1705to the location he/she was before the call to C<enter_link>, or, if that
1584to the emergency map position. 1706fails, to the emergency map position.
1585 1707
1586Might block. 1708Might block.
1587 1709
1588=cut 1710=cut
1711
1712sub link_map {
1713 unless ($LINK_MAP) {
1714 $LINK_MAP = cf::map::find "{link}"
1715 or do { warn "FATAL: unable to provide {link} map, exiting."; exit 1 };
1716 $LINK_MAP->load;
1717 }
1718
1719 $LINK_MAP
1720}
1589 1721
1590sub cf::object::player::enter_link { 1722sub cf::object::player::enter_link {
1591 my ($self) = @_; 1723 my ($self) = @_;
1592 1724
1593 $self->deactivate_recursive; 1725 $self->deactivate_recursive;
1594 1726
1595 return if $self->map == $LINK_MAP; 1727 return if UNIVERSAL::isa $self->map, "ext::map_link";
1596 1728
1597 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 1729 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
1598 if $self->map; 1730 if $self->map;
1599 1731
1600 $self->enter_map ($LINK_MAP, 20, 20); 1732 $self->enter_map ($LINK_MAP || link_map, 20, 20);
1601} 1733}
1602 1734
1603sub cf::object::player::leave_link { 1735sub cf::object::player::leave_link {
1604 my ($self, $map, $x, $y) = @_; 1736 my ($self, $map, $x, $y) = @_;
1605 1737
… …
1623 # use -1 or undef as default coordinates, not 0, 0 1755 # use -1 or undef as default coordinates, not 0, 0
1624 ($x, $y) = ($map->enter_x, $map->enter_y) 1756 ($x, $y) = ($map->enter_x, $map->enter_y)
1625 if $x <=0 && $y <= 0; 1757 if $x <=0 && $y <= 0;
1626 1758
1627 $map->load; 1759 $map->load;
1760 $map->load_diag;
1628 1761
1629 return unless $self->contr->active; 1762 return unless $self->contr->active;
1630 $self->activate_recursive; 1763 $self->activate_recursive;
1631 $self->enter_map ($map, $x, $y); 1764 $self->enter_map ($map, $x, $y);
1632} 1765}
… …
1671 my ($self, $path, $x, $y) = @_; 1804 my ($self, $path, $x, $y) = @_;
1672 1805
1673 $self->enter_link; 1806 $self->enter_link;
1674 1807
1675 (async { 1808 (async {
1676 $path = new cf::path $path;
1677
1678 my $map = cf::map::find $path->as_string; 1809 my $map = cf::map::find $path;
1679 $map = $map->customise_for ($self) if $map; 1810 $map = $map->customise_for ($self) if $map;
1680 1811
1681# warn "entering ", $map->path, " at ($x, $y)\n" 1812# warn "entering ", $map->path, " at ($x, $y)\n"
1682# if $map; 1813# if $map;
1683 1814
1684 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1815 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1685 1816
1686 $self->leave_link ($map, $x, $y); 1817 $self->leave_link ($map, $x, $y);
1687 })->prio (1); 1818 })->prio (1);
1688} 1819}
1689 1820
… …
1693 1824
1694sub parse_random_map_params { 1825sub parse_random_map_params {
1695 my ($spec) = @_; 1826 my ($spec) = @_;
1696 1827
1697 my $rmp = { # defaults 1828 my $rmp = { # defaults
1698 xsize => 10, 1829 xsize => (cf::rndm 15, 40),
1699 ysize => 10, 1830 ysize => (cf::rndm 15, 40),
1831 symmetry => (cf::rndm 1, cf::SYMMETRY_XY),
1832 #layout => string,
1700 }; 1833 };
1701 1834
1702 for (split /\n/, $spec) { 1835 for (split /\n/, $spec) {
1703 my ($k, $v) = split /\s+/, $_, 2; 1836 my ($k, $v) = split /\s+/, $_, 2;
1704 1837
… …
1708 $rmp 1841 $rmp
1709} 1842}
1710 1843
1711sub prepare_random_map { 1844sub prepare_random_map {
1712 my ($exit) = @_; 1845 my ($exit) = @_;
1846
1847 my $guard = cf::lock_acquire "exit_prepare:$exit";
1713 1848
1714 # all this does is basically replace the /! path by 1849 # all this does is basically replace the /! path by
1715 # a new random map path (?random/...) with a seed 1850 # a new random map path (?random/...) with a seed
1716 # that depends on the exit object 1851 # that depends on the exit object
1717 1852
… …
1726 1861
1727 $rmp->{random_seed} ||= $exit->random_seed; 1862 $rmp->{random_seed} ||= $exit->random_seed;
1728 1863
1729 my $data = cf::to_json $rmp; 1864 my $data = cf::to_json $rmp;
1730 my $md5 = Digest::MD5::md5_hex $data; 1865 my $md5 = Digest::MD5::md5_hex $data;
1866 my $meta = "$cf::RANDOM_MAPS/$md5.meta";
1731 1867
1732 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) { 1868 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
1733 aio_write $fh, 0, (length $data), $data, 0; 1869 aio_write $fh, 0, (length $data), $data, 0;
1870 undef $fh;
1871 aio_rename "$meta~", $meta;
1734 1872
1735 $exit->slaying ("?random/$md5"); 1873 $exit->slaying ("?random/$md5");
1736 $exit->msg (undef); 1874 $exit->msg (undef);
1737 } 1875 }
1738} 1876}
… …
1748 $self->deactivate_recursive; # just to be sure 1886 $self->deactivate_recursive; # just to be sure
1749 unless (eval { 1887 unless (eval {
1750 prepare_random_map $exit 1888 prepare_random_map $exit
1751 if $exit->slaying eq "/!"; 1889 if $exit->slaying eq "/!";
1752 1890
1753 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1891 my $path = new_from_path cf::map $exit->slaying, $exit->map && $exit->map->path;
1754 $self->goto ($path, $exit->stats->hp, $exit->stats->sp); 1892 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1755 1893
1756 1; 1894 1;
1757 }) { 1895 }) {
1758 $self->message ("Something went wrong deep within the crossfire server. " 1896 $self->message ("Something went wrong deep within the crossfire server. "
1759 . "I'll try to bring you back to the map you were before. " 1897 . "I'll try to bring you back to the map you were before. "
1760 . "Please report this to the dungeon master", 1898 . "Please report this to the dungeon master!",
1761 cf::NDI_UNIQUE | cf::NDI_RED); 1899 cf::NDI_UNIQUE | cf::NDI_RED);
1762 1900
1763 warn "ERROR in enter_exit: $@"; 1901 warn "ERROR in enter_exit: $@";
1764 $self->leave_link; 1902 $self->leave_link;
1765 } 1903 }
… …
2048 sub db_sync() { 2186 sub db_sync() {
2049 db_save if $dirty; 2187 db_save if $dirty;
2050 undef $dirty; 2188 undef $dirty;
2051 } 2189 }
2052 2190
2053 my $idle = Event->idle (min => $TICK * 2.8, max => 10, repeat => 0, data => WF_AUTOCANCEL, cb => sub { 2191 my $idle = Event->idle (min => 10, max => 20, repeat => 0, data => WF_AUTOCANCEL, cb => sub {
2054 db_sync; 2192 db_sync;
2055 }); 2193 });
2056 2194
2057 sub db_dirty() { 2195 sub db_dirty() {
2058 $dirty = 1; 2196 $dirty = 1;
… …
2097 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 2235 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2098 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 2236 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2099 2237
2100 if (exists $CFG{mlockall}) { 2238 if (exists $CFG{mlockall}) {
2101 eval { 2239 eval {
2102 $CFG{mlockall} ? &mlockall : &munlockall 2240 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2103 and die "WARNING: m(un)lockall failed: $!\n"; 2241 and die "WARNING: m(un)lockall failed: $!\n";
2104 }; 2242 };
2105 warn $@ if $@; 2243 warn $@ if $@;
2106 } 2244 }
2107} 2245}
2108 2246
2109sub main { 2247sub main {
2110 # we must not ever block the main coroutine 2248 # we must not ever block the main coroutine
2111 local $Coro::idle = sub { 2249 local $Coro::idle = sub {
2112 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2250 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2251 (async {
2113 async { Event::one_event }; 2252 Event::one_event;
2253 })->prio (Coro::PRIO_MAX);
2114 }; 2254 };
2115 2255
2116 cfg_load; 2256 cfg_load;
2117 db_load; 2257 db_load;
2118 load_extensions; 2258 load_extensions;
2259
2260 $TICK_WATCHER->start;
2119 Event::loop; 2261 Event::loop;
2120} 2262}
2121 2263
2122############################################################################# 2264#############################################################################
2123# initialisation 2265# initialisation and cleanup
2266
2267# install some emergency cleanup handlers
2268BEGIN {
2269 for my $signal (qw(INT HUP TERM)) {
2270 Event->signal (
2271 data => WF_AUTOCANCEL,
2272 signal => $signal,
2273 cb => sub {
2274 cf::cleanup "SIG$signal";
2275 },
2276 );
2277 }
2278}
2279
2280sub emergency_save() {
2281 my $freeze_guard = cf::freeze_mainloop;
2282
2283 warn "enter emergency perl save\n";
2284
2285 cf::sync_job {
2286 # use a peculiar iteration method to avoid tripping on perl
2287 # refcount bugs in for. also avoids problems with players
2288 # and maps saved/destroyed asynchronously.
2289 warn "begin emergency player save\n";
2290 for my $login (keys %cf::PLAYER) {
2291 my $pl = $cf::PLAYER{$login} or next;
2292 $pl->valid or next;
2293 $pl->save;
2294 }
2295 warn "end emergency player save\n";
2296
2297 warn "begin emergency map save\n";
2298 for my $path (keys %cf::MAP) {
2299 my $map = $cf::MAP{$path} or next;
2300 $map->valid or next;
2301 $map->save;
2302 }
2303 warn "end emergency map save\n";
2304 };
2305
2306 warn "leave emergency perl save\n";
2307}
2124 2308
2125sub reload() { 2309sub reload() {
2126 # can/must only be called in main 2310 # can/must only be called in main
2127 if ($Coro::current != $Coro::main) { 2311 if ($Coro::current != $Coro::main) {
2128 warn "can only reload from main coroutine\n"; 2312 warn "can only reload from main coroutine";
2129 return; 2313 return;
2130 } 2314 }
2131 2315
2132 warn "reloading..."; 2316 warn "reloading...";
2133 2317
2134 my $guard = freeze_mainloop; 2318 warn "cancelling server ticker";
2319 $TICK_WATCHER->cancel;
2320
2135 cf::emergency_save; 2321 cf::emergency_save;
2136 2322
2137 eval { 2323 eval {
2138 # if anything goes wrong in here, we should simply crash as we already saved 2324 # if anything goes wrong in here, we should simply crash as we already saved
2139 2325
2140 # cancel all watchers 2326 warn "syncing database to disk";
2327 cf::db_sync;
2328
2329 warn "cancelling all WF_AUTOCANCEL watchers";
2141 for (Event::all_watchers) { 2330 for (Event::all_watchers) {
2142 $_->cancel if $_->data & WF_AUTOCANCEL; 2331 $_->cancel if $_->data & WF_AUTOCANCEL;
2143 } 2332 }
2144 2333
2334 warn "flushing outstanding aio requests";
2335 for (;;) {
2336 IO::AIO::flush;
2337 Coro::cede;
2338 last unless IO::AIO::nreqs;
2339 warn "iterate...";
2340 }
2341
2145 # cancel all extension coros 2342 warn "cancelling all extension coros";
2146 $_->cancel for values %EXT_CORO; 2343 $_->cancel for values %EXT_CORO;
2147 %EXT_CORO = (); 2344 %EXT_CORO = ();
2148 2345
2149 # unload all extensions 2346 warn "removing commands";
2150 for (@exts) { 2347 %COMMAND = ();
2348
2349 warn "removing ext commands";
2350 %EXTCMD = ();
2351
2352 warn "unloading/nuking all extensions";
2353 for my $pkg (@EXTS) {
2151 warn "unloading <$_>"; 2354 warn "... unloading $pkg";
2152 unload_extension $_; 2355
2356 if (my $cb = $pkg->can ("unload")) {
2357 eval {
2358 $cb->($pkg);
2359 1
2360 } or warn "$pkg unloaded, but with errors: $@";
2153 } 2361 }
2154 2362
2363 warn "... nuking $pkg";
2364 Symbol::delete_package $pkg;
2365 }
2366
2155 # unload all modules loaded from $LIBDIR 2367 warn "unloading all perl modules loaded from $LIBDIR";
2156 while (my ($k, $v) = each %INC) { 2368 while (my ($k, $v) = each %INC) {
2157 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2369 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2158 2370
2159 warn "removing <$k>"; 2371 warn "... unloading $k";
2160 delete $INC{$k}; 2372 delete $INC{$k};
2161 2373
2162 $k =~ s/\.pm$//; 2374 $k =~ s/\.pm$//;
2163 $k =~ s/\//::/g; 2375 $k =~ s/\//::/g;
2164 2376
… …
2167 } 2379 }
2168 2380
2169 Symbol::delete_package $k; 2381 Symbol::delete_package $k;
2170 } 2382 }
2171 2383
2172 # sync database to disk
2173 cf::db_sync;
2174 IO::AIO::flush;
2175
2176 # get rid of safe::, as good as possible 2384 warn "getting rid of safe::, as good as possible";
2177 Symbol::delete_package "safe::$_" 2385 Symbol::delete_package "safe::$_"
2178 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2386 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2179 2387
2180 # remove register_script_function callbacks
2181 # TODO
2182
2183 # unload cf.pm "a bit" 2388 warn "unloading cf.pm \"a bit\"";
2184 delete $INC{"cf.pm"}; 2389 delete $INC{"cf.pm"};
2185 2390
2186 # don't, removes xs symbols, too, 2391 # don't, removes xs symbols, too,
2187 # and global variables created in xs 2392 # and global variables created in xs
2188 #Symbol::delete_package __PACKAGE__; 2393 #Symbol::delete_package __PACKAGE__;
2189 2394
2190 # reload cf.pm 2395 warn "unload completed, starting to reload now";
2396
2191 warn "reloading cf.pm"; 2397 warn "reloading cf.pm";
2192 require cf; 2398 require cf;
2193 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2399 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2194 2400
2195 # load config and database again 2401 warn "loading config and database again";
2196 cf::cfg_load; 2402 cf::cfg_load;
2197 cf::db_load; 2403 cf::db_load;
2198 2404
2199 # load extensions
2200 warn "load extensions"; 2405 warn "loading extensions";
2201 cf::load_extensions; 2406 cf::load_extensions;
2202 2407
2203 # reattach attachments to objects 2408 warn "reattaching attachments to objects/players";
2204 warn "reattach";
2205 _global_reattach; 2409 _global_reattach;
2410 warn "reattaching attachments to maps";
2206 reattach $_ for values %MAP; 2411 reattach $_ for values %MAP;
2412
2413 warn "restarting server ticker";
2414
2415 $TICK_WATCHER->start;
2207 }; 2416 };
2208 2417
2209 if ($@) { 2418 if ($@) {
2210 warn $@; 2419 warn $@;
2211 warn "error while reloading, exiting."; 2420 warn "error while reloading, exiting.";
2212 exit 1; 2421 exit 1;
2213 } 2422 }
2214 2423
2215 warn "reloaded successfully"; 2424 warn "reloaded";
2216}; 2425};
2217 2426
2218############################################################################# 2427our $RELOAD_WATCHER; # used only during reload
2219
2220unless ($LINK_MAP) {
2221 $LINK_MAP = cf::map::new;
2222
2223 $LINK_MAP->width (41);
2224 $LINK_MAP->height (41);
2225 $LINK_MAP->alloc;
2226 $LINK_MAP->path ("{link}");
2227 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2228 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2229
2230 # dirty hack because... archetypes are not yet loaded
2231 Event->timer (
2232 after => 10,
2233 cb => sub {
2234 $_[0]->w->cancel;
2235
2236 # provide some exits "home"
2237 my $exit = cf::object::new "exit";
2238
2239 $exit->slaying ($EMERGENCY_POSITION->[0]);
2240 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2241 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2242
2243 $LINK_MAP->insert ($exit->clone, 19, 19);
2244 $LINK_MAP->insert ($exit->clone, 19, 20);
2245 $LINK_MAP->insert ($exit->clone, 19, 21);
2246 $LINK_MAP->insert ($exit->clone, 20, 19);
2247 $LINK_MAP->insert ($exit->clone, 20, 21);
2248 $LINK_MAP->insert ($exit->clone, 21, 19);
2249 $LINK_MAP->insert ($exit->clone, 21, 20);
2250 $LINK_MAP->insert ($exit->clone, 21, 21);
2251
2252 $exit->destroy;
2253 });
2254
2255 $LINK_MAP->{deny_save} = 1;
2256 $LINK_MAP->{deny_reset} = 1;
2257
2258 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2259}
2260
2261register "<global>", __PACKAGE__;
2262 2428
2263register_command "reload" => sub { 2429register_command "reload" => sub {
2264 my ($who, $arg) = @_; 2430 my ($who, $arg) = @_;
2265 2431
2266 if ($who->flag (FLAG_WIZ)) { 2432 if ($who->flag (FLAG_WIZ)) {
2267 $who->message ("start of reload."); 2433 $who->message ("reloading server.");
2434
2435 # doing reload synchronously and two reloads happen back-to-back,
2436 # coro crashes during coro_state_free->destroy here.
2437
2438 $RELOAD_WATCHER ||= Event->timer (after => 0, data => WF_AUTOCANCEL, cb => sub {
2268 reload; 2439 reload;
2269 $who->message ("end of reload."); 2440 undef $RELOAD_WATCHER;
2441 });
2270 } 2442 }
2271}; 2443};
2272 2444
2273unshift @INC, $LIBDIR; 2445unshift @INC, $LIBDIR;
2446
2447my $bug_warning = 0;
2274 2448
2275$TICK_WATCHER = Event->timer ( 2449$TICK_WATCHER = Event->timer (
2276 reentrant => 0, 2450 reentrant => 0,
2451 parked => 1,
2277 prio => 0, 2452 prio => 0,
2278 at => $NEXT_TICK || $TICK, 2453 at => $NEXT_TICK || $TICK,
2279 data => WF_AUTOCANCEL, 2454 data => WF_AUTOCANCEL,
2280 cb => sub { 2455 cb => sub {
2456 if ($Coro::current != $Coro::main) {
2457 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
2458 unless ++$bug_warning > 10;
2459 return;
2460 }
2461
2462 $NOW = Event::time;
2463
2281 cf::server_tick; # one server iteration 2464 cf::server_tick; # one server iteration
2282 $RUNTIME += $TICK; 2465 $RUNTIME += $TICK;
2283 $NEXT_TICK += $TICK; 2466 $NEXT_TICK += $TICK;
2467
2468 $WAIT_FOR_TICK->broadcast;
2469 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2284 2470
2285 # if we are delayed by four ticks or more, skip them all 2471 # if we are delayed by four ticks or more, skip them all
2286 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2472 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2287 2473
2288 $TICK_WATCHER->at ($NEXT_TICK); 2474 $TICK_WATCHER->at ($NEXT_TICK);
… …
2290 }, 2476 },
2291); 2477);
2292 2478
2293IO::AIO::max_poll_time $TICK * 0.2; 2479IO::AIO::max_poll_time $TICK * 0.2;
2294 2480
2295Event->io ( 2481$AIO_POLL_WATCHER = Event->io (
2296 fd => IO::AIO::poll_fileno, 2482 fd => IO::AIO::poll_fileno,
2297 poll => 'r', 2483 poll => 'r',
2298 prio => 5, 2484 prio => 5,
2299 data => WF_AUTOCANCEL, 2485 data => WF_AUTOCANCEL,
2300 cb => \&IO::AIO::poll_cb, 2486 cb => \&IO::AIO::poll_cb,
2301); 2487);
2302 2488
2303Event->timer ( 2489$WRITE_RUNTIME_WATCHER = Event->timer (
2304 data => WF_AUTOCANCEL, 2490 data => WF_AUTOCANCEL,
2305 after => 0, 2491 after => 1,
2306 interval => 10, 2492 interval => 10,
2307 cb => sub { 2493 prio => 6, # keep it lowest so it acts like a watchdog
2308 (Coro::unblock_sub { 2494 cb => Coro::unblock_sub {
2309 write_runtime 2495 write_runtime
2310 or warn "ERROR: unable to write runtime file: $!"; 2496 or warn "ERROR: unable to write runtime file: $!";
2311 })->();
2312 }, 2497 },
2313); 2498);
2314 2499
2315END { cf::emergency_save } 2500END { cf::emergency_save }
2316 2501

Diff Legend

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