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.434 by root, Thu May 29 03:27:37 2008 UTC vs.
Revision 1.485 by root, Mon Oct 12 14:12:54 2009 UTC

1# 1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG. 2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3# 3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify 6# Deliantra is free software: you can redistribute it and/or modify it under
7# it under the terms of the GNU General Public License as published by 7# the terms of the Affero GNU General Public License as published by the
8# the Free Software Foundation, either version 3 of the License, or 8# Free Software Foundation, either version 3 of the License, or (at your
9# (at your option) any later version. 9# option) any later version.
10# 10#
11# This program is distributed in the hope that it will be useful, 11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details. 14# GNU General Public License for more details.
15# 15#
16# You should have received a copy of the GNU General Public License 16# You should have received a copy of the Affero GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>. 17# and the GNU General Public License along with this program. If not, see
18# <http://www.gnu.org/licenses/>.
18# 19#
19# The authors can be reached via e-mail to <support@deliantra.net> 20# The authors can be reached via e-mail to <support@deliantra.net>
20# 21#
21 22
22package cf; 23package cf;
23 24
25use 5.10.0;
24use utf8; 26use utf8;
25use strict; 27use strict qw(vars subs);
26 28
27use Symbol; 29use Symbol;
28use List::Util; 30use List::Util;
29use Socket; 31use Socket;
30use EV; 32use EV;
31use Opcode; 33use Opcode;
32use Safe; 34use Safe;
33use Safe::Hole; 35use Safe::Hole;
34use Storable (); 36use Storable ();
35 37
38use Guard ();
36use Coro (); 39use Coro ();
37use Coro::State; 40use Coro::State;
38use Coro::Handle; 41use Coro::Handle;
42use Coro::EV;
39use Coro::AnyEvent; 43use Coro::AnyEvent;
40use Coro::Timer; 44use Coro::Timer;
41use Coro::Signal; 45use Coro::Signal;
42use Coro::Semaphore; 46use Coro::Semaphore;
47use Coro::SemaphoreSet;
43use Coro::AnyEvent; 48use Coro::AnyEvent;
44use Coro::AIO; 49use Coro::AIO;
45use Coro::BDB; 50use Coro::BDB 1.6;
46use Coro::Storable; 51use Coro::Storable;
47use Coro::Util (); 52use Coro::Util ();
48 53
49use JSON::XS 2.01 (); 54use JSON::XS 2.01 ();
50use BDB (); 55use BDB ();
51use Data::Dumper; 56use Data::Dumper;
52use Digest::MD5; 57use Digest::MD5;
53use Fcntl; 58use Fcntl;
54use YAML (); 59use YAML::XS ();
55use IO::AIO (); 60use IO::AIO ();
56use Time::HiRes; 61use Time::HiRes;
57use Compress::LZF; 62use Compress::LZF;
58use Digest::MD5 (); 63use Digest::MD5 ();
59 64
60AnyEvent::detect; 65AnyEvent::detect;
61 66
62IO::AIO::max_poll_reqs 1;#d#
63
64# configure various modules to our taste 67# configure various modules to our taste
65# 68#
66$Storable::canonical = 1; # reduce rsync transfers 69$Storable::canonical = 1; # reduce rsync transfers
67Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 70Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
71
72$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
73
74# make sure c-lzf reinitialises itself
75Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve";
68Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 76Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
69 77
70$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 78# strictly for debugging
79$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
71 80
72sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 81sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
73 82
74our %COMMAND = (); 83our %COMMAND = ();
75our %COMMAND_TIME = (); 84our %COMMAND_TIME = ();
… …
78our %EXTCMD = (); 87our %EXTCMD = ();
79our %EXTICMD = (); 88our %EXTICMD = ();
80our %EXT_CORO = (); # coroutines bound to extensions 89our %EXT_CORO = (); # coroutines bound to extensions
81our %EXT_MAP = (); # pluggable maps 90our %EXT_MAP = (); # pluggable maps
82 91
83our $RELOAD; # number of reloads so far 92our $RELOAD; # number of reloads so far, non-zero while in reload
84our @EVENT; 93our @EVENT;
94our @REFLECT; # set by XS
95our %REFLECT; # set by us
85 96
86our $CONFDIR = confdir; 97our $CONFDIR = confdir;
87our $DATADIR = datadir; 98our $DATADIR = datadir;
88our $LIBDIR = "$DATADIR/ext"; 99our $LIBDIR = "$DATADIR/ext";
89our $PODDIR = "$DATADIR/pod"; 100our $PODDIR = "$DATADIR/pod";
90our $MAPDIR = "$DATADIR/" . mapdir; 101our $MAPDIR = "$DATADIR/" . mapdir;
91our $LOCALDIR = localdir; 102our $LOCALDIR = localdir;
92our $TMPDIR = "$LOCALDIR/" . tmpdir; 103our $TMPDIR = "$LOCALDIR/" . tmpdir;
93our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 104our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
94our $PLAYERDIR = "$LOCALDIR/" . playerdir; 105our $PLAYERDIR = "$LOCALDIR/" . playerdir;
95our $RANDOMDIR = "$LOCALDIR/random"; 106our $RANDOMDIR = "$LOCALDIR/random";
96our $BDBDIR = "$LOCALDIR/db"; 107our $BDBDIR = "$LOCALDIR/db";
108our $PIDFILE = "$LOCALDIR/pid";
109our $RUNTIMEFILE = "$LOCALDIR/runtime";
110
97our %RESOURCE; 111our %RESOURCE;
98 112
99our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 113our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
100our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 114our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
101our $NEXT_TICK; 115our $NEXT_TICK;
102our $USE_FSYNC = 1; # use fsync to write maps - default off 116our $USE_FSYNC = 1; # use fsync to write maps - default on
103 117
104our $BDB_DEADLOCK_WATCHER; 118our $BDB_DEADLOCK_WATCHER;
105our $BDB_CHECKPOINT_WATCHER; 119our $BDB_CHECKPOINT_WATCHER;
106our $BDB_TRICKLE_WATCHER; 120our $BDB_TRICKLE_WATCHER;
107our $DB_ENV; 121our $DB_ENV;
108 122
123our @EXTRA_MODULES = qw(pod match mapscript);
124
109our %CFG; 125our %CFG;
110 126
111our $UPTIME; $UPTIME ||= time; 127our $UPTIME; $UPTIME ||= time;
112our $RUNTIME; 128our $RUNTIME;
113our $NOW; 129our $NOW;
… …
122our $LOAD; # a number between 0 (idle) and 1 (too many objects) 138our $LOAD; # a number between 0 (idle) and 1 (too many objects)
123our $LOADAVG; # same thing, but with alpha-smoothing 139our $LOADAVG; # same thing, but with alpha-smoothing
124our $JITTER; # average jitter 140our $JITTER; # average jitter
125our $TICK_START; # for load detecting purposes 141our $TICK_START; # for load detecting purposes
126 142
143our @POST_INIT;
144
145our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
146our $REALLY_UNLOOP; # never set to true, please :)
147
127binmode STDOUT; 148binmode STDOUT;
128binmode STDERR; 149binmode STDERR;
129 150
130# read virtual server time, if available 151# read virtual server time, if available
131unless ($RUNTIME || !-e "$LOCALDIR/runtime") { 152unless ($RUNTIME || !-e $RUNTIMEFILE) {
132 open my $fh, "<", "$LOCALDIR/runtime" 153 open my $fh, "<", $RUNTIMEFILE
133 or die "unable to read runtime file: $!"; 154 or die "unable to read $RUNTIMEFILE file: $!";
134 $RUNTIME = <$fh> + 0.; 155 $RUNTIME = <$fh> + 0.;
135} 156}
157
158eval "sub TICK() { $TICK } 1" or die;
136 159
137mkdir $_ 160mkdir $_
138 for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR; 161 for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR;
139 162
140our $EMERGENCY_POSITION; 163our $EMERGENCY_POSITION;
141 164
142sub cf::map::normalise; 165sub cf::map::normalise;
166
167#############################################################################
168
169%REFLECT = ();
170for (@REFLECT) {
171 my $reflect = JSON::XS::decode_json $_;
172 $REFLECT{$reflect->{class}} = $reflect;
173}
174
175# this is decidedly evil
176$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
143 177
144############################################################################# 178#############################################################################
145 179
146=head2 GLOBAL VARIABLES 180=head2 GLOBAL VARIABLES
147 181
… …
198 232
199This array contains the results of the last C<invoke ()> call. When 233This array contains the results of the last C<invoke ()> call. When
200C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of 234C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
201that call. 235that call.
202 236
237=item %cf::REFLECT
238
239Contains, for each (C++) class name, a hash reference with information
240about object members (methods, scalars, arrays and flags) and other
241metadata, which is useful for introspection.
242
203=back 243=back
204 244
205=cut 245=cut
206 246
207BEGIN { 247$Coro::State::WARNHOOK = sub {
208 *CORE::GLOBAL::warn = sub {
209 my $msg = join "", @_; 248 my $msg = join "", @_;
210 249
211 $msg .= "\n" 250 $msg .= "\n"
212 unless $msg =~ /\n$/; 251 unless $msg =~ /\n$/;
213 252
214 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 253 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
215 254
216 LOG llevError, $msg; 255 LOG llevError, $msg;
217 }; 256};
218}
219 257
220$Coro::State::DIEHOOK = sub { 258$Coro::State::DIEHOOK = sub {
221 return unless $^S eq 0; # "eq", not "==" 259 return unless $^S eq 0; # "eq", not "=="
260
261 warn Carp::longmess $_[0];
222 262
223 if ($Coro::current == $Coro::main) {#d# 263 if ($Coro::current == $Coro::main) {#d#
224 warn "DIEHOOK called in main context, Coro bug?\n";#d# 264 warn "DIEHOOK called in main context, Coro bug?\n";#d#
225 return;#d# 265 return;#d#
226 }#d# 266 }#d#
227 267
228 # kill coroutine otherwise 268 # kill coroutine otherwise
229 warn Carp::longmess $_[0];
230 Coro::terminate 269 Coro::terminate
231}; 270};
232
233$SIG{__DIE__} = sub { }; #d#?
234 271
235@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 272@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
236@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 273@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
237@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 274@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
238@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 275@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
245for my $pkg (qw( 282for my $pkg (qw(
246 cf::global cf::attachable 283 cf::global cf::attachable
247 cf::object cf::object::player 284 cf::object cf::object::player
248 cf::client cf::player 285 cf::client cf::player
249 cf::arch cf::living 286 cf::arch cf::living
287 cf::map cf::mapspace
250 cf::map cf::party cf::region 288 cf::party cf::region
251)) { 289)) {
252 no strict 'refs';
253 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 290 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
254} 291}
255 292
256$EV::DIED = sub { 293$EV::DIED = sub {
257 warn "error in event callback: @_"; 294 warn "error in event callback: @_";
… …
299our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 336our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
300 337
301sub encode_json($) { $json_coder->encode ($_[0]) } 338sub encode_json($) { $json_coder->encode ($_[0]) }
302sub decode_json($) { $json_coder->decode ($_[0]) } 339sub decode_json($) { $json_coder->decode ($_[0]) }
303 340
341=item cf::post_init { BLOCK }
342
343Execute the given codeblock, I<after> all extensions have been (re-)loaded,
344but I<before> the server starts ticking again.
345
346The cdoeblock will have a single boolean argument to indicate whether this
347is a reload or not.
348
349=cut
350
351sub post_init(&) {
352 push @POST_INIT, shift;
353}
354
304=item cf::lock_wait $string 355=item cf::lock_wait $string
305 356
306Wait until the given lock is available. See cf::lock_acquire. 357Wait until the given lock is available. See cf::lock_acquire.
307 358
308=item my $lock = cf::lock_acquire $string 359=item my $lock = cf::lock_acquire $string
309 360
310Wait until the given lock is available and then acquires it and returns 361Wait until the given lock is available and then acquires it and returns
311a Coro::guard object. If the guard object gets destroyed (goes out of scope, 362a L<Guard> object. If the guard object gets destroyed (goes out of scope,
312for example when the coroutine gets canceled), the lock is automatically 363for example when the coroutine gets canceled), the lock is automatically
313returned. 364returned.
314 365
315Locks are *not* recursive, locking from the same coro twice results in a 366Locks are *not* recursive, locking from the same coro twice results in a
316deadlocked coro. 367deadlocked coro.
… …
322 373
323Return true if the lock is currently active, i.e. somebody has locked it. 374Return true if the lock is currently active, i.e. somebody has locked it.
324 375
325=cut 376=cut
326 377
327our %LOCK; 378our $LOCKS = new Coro::SemaphoreSet;
328our %LOCKER;#d#
329 379
330sub lock_wait($) { 380sub lock_wait($) {
331 my ($key) = @_; 381 $LOCKS->wait ($_[0]);
332
333 if ($LOCKER{$key} == $Coro::current) {#d#
334 Carp::cluck "lock_wait($key) for already-acquired lock";#d#
335 return;#d#
336 }#d#
337
338 # wait for lock, if any
339 while ($LOCK{$key}) {
340 push @{ $LOCK{$key} }, $Coro::current;
341 Coro::schedule;
342 }
343} 382}
344 383
345sub lock_acquire($) { 384sub lock_acquire($) {
346 my ($key) = @_; 385 $LOCKS->guard ($_[0])
347
348 # wait, to be sure we are not locked
349 lock_wait $key;
350
351 $LOCK{$key} = [];
352 $LOCKER{$key} = $Coro::current;#d#
353
354 Coro::guard {
355 delete $LOCKER{$key};#d#
356 # wake up all waiters, to be on the safe side
357 $_->ready for @{ delete $LOCK{$key} };
358 }
359} 386}
360 387
361sub lock_active($) { 388sub lock_active($) {
362 my ($key) = @_; 389 $LOCKS->count ($_[0]) < 1
363
364 ! ! $LOCK{$key}
365} 390}
366 391
367sub freeze_mainloop { 392sub freeze_mainloop {
368 tick_inhibit_inc; 393 tick_inhibit_inc;
369 394
370 Coro::guard \&tick_inhibit_dec; 395 &Guard::guard (\&tick_inhibit_dec);
371} 396}
372 397
373=item cf::periodic $interval, $cb 398=item cf::periodic $interval, $cb
374 399
375Like EV::periodic, but randomly selects a starting point so that the actions 400Like EV::periodic, but randomly selects a starting point so that the actions
… …
727 752
728############################################################################# 753#############################################################################
729 754
730=head2 ATTACHABLE OBJECTS 755=head2 ATTACHABLE OBJECTS
731 756
732Many objects in crossfire are so-called attachable objects. That means you can 757Many objects in deliantra are so-called attachable objects. That means you can
733attach callbacks/event handlers (a collection of which is called an "attachment") 758attach callbacks/event handlers (a collection of which is called an "attachment")
734to it. All such attachable objects support the following methods. 759to it. All such attachable objects support the following methods.
735 760
736In the following description, CLASS can be any of C<global>, C<object> 761In the following description, CLASS can be any of C<global>, C<object>
737C<player>, C<client> or C<map> (i.e. the attachable objects in 762C<player>, C<client> or C<map> (i.e. the attachable objects in
… …
787=item cf::CLASS::attachment $name, ... 812=item cf::CLASS::attachment $name, ...
788 813
789Register an attachment by C<$name> through which attachable objects of the 814Register an attachment by C<$name> through which attachable objects of the
790given CLASS can refer to this attachment. 815given CLASS can refer to this attachment.
791 816
792Some classes such as crossfire maps and objects can specify attachments 817Some classes such as deliantra maps and objects can specify attachments
793that are attached at load/instantiate time, thus the need for a name. 818that are attached at load/instantiate time, thus the need for a name.
794 819
795These calls expect any number of the following handler/hook descriptions: 820These calls expect any number of the following handler/hook descriptions:
796 821
797=over 4 822=over 4
… …
1088 1113
1089sub reattach { 1114sub reattach {
1090 # basically do the same as instantiate, without calling instantiate 1115 # basically do the same as instantiate, without calling instantiate
1091 my ($obj) = @_; 1116 my ($obj) = @_;
1092 1117
1118 # no longer needed after getting rid of delete_package?
1093 bless $obj, ref $obj; # re-bless in case extensions have been reloaded 1119 #bless $obj, ref $obj; # re-bless in case extensions have been reloaded
1094 1120
1095 my $registry = $obj->registry; 1121 my $registry = $obj->registry;
1096 1122
1097 @$registry = (); 1123 @$registry = ();
1098 1124
… …
1146 $decname, length $$rdata, scalar @$objs; 1172 $decname, length $$rdata, scalar @$objs;
1147 1173
1148 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1174 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1149 aio_chmod $fh, SAVE_MODE; 1175 aio_chmod $fh, SAVE_MODE;
1150 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1176 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1151 aio_fsync $fh if $cf::USE_FSYNC; 1177 if ($cf::USE_FSYNC) {
1178 aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
1179 aio_fsync $fh;
1180 }
1152 aio_close $fh; 1181 aio_close $fh;
1153 1182
1154 if (@$objs) { 1183 if (@$objs) {
1155 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) { 1184 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
1156 aio_chmod $fh, SAVE_MODE; 1185 aio_chmod $fh, SAVE_MODE;
1157 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs }; 1186 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
1158 aio_write $fh, 0, (length $data), $data, 0; 1187 aio_write $fh, 0, (length $data), $data, 0;
1159 aio_fsync $fh if $cf::USE_FSYNC; 1188 if ($cf::USE_FSYNC) {
1189 aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
1190 aio_fsync $fh;
1191 }
1160 aio_close $fh; 1192 aio_close $fh;
1161 aio_rename "$filename.pst~", "$filename.pst"; 1193 aio_rename "$filename.pst~", "$filename.pst";
1162 } 1194 }
1163 } else { 1195 } else {
1164 aio_unlink "$filename.pst"; 1196 aio_unlink "$filename.pst";
1165 } 1197 }
1166 1198
1167 aio_rename "$filename~", $filename; 1199 aio_rename "$filename~", $filename;
1200
1201 $filename =~ s%/[^/]+$%%;
1202 aio_pathsync $filename if $cf::USE_FSYNC;
1168 } else { 1203 } else {
1169 warn "FATAL: $filename~: $!\n"; 1204 warn "unable to save objects: $filename~: $!\n";
1170 } 1205 }
1171 } else { 1206 } else {
1172 aio_unlink $filename; 1207 aio_unlink $filename;
1173 aio_unlink "$filename.pst"; 1208 aio_unlink "$filename.pst";
1174 } 1209 }
… …
1265 my ($name, $cb) = @_; 1300 my ($name, $cb) = @_;
1266 1301
1267 $EXTICMD{$name} = $cb; 1302 $EXTICMD{$name} = $cb;
1268} 1303}
1269 1304
1305use File::Glob ();
1306
1270cf::player->attach ( 1307cf::player->attach (
1271 on_command => sub { 1308 on_command => sub {
1272 my ($pl, $name, $params) = @_; 1309 my ($pl, $name, $params) = @_;
1273 1310
1274 my $cb = $COMMAND{$name} 1311 my $cb = $COMMAND{$name}
… …
1306 1343
1307 cf::override; 1344 cf::override;
1308 }, 1345 },
1309); 1346);
1310 1347
1348# "readahead" all extensions
1349sub cache_extensions {
1350 my $grp = IO::AIO::aio_group;
1351
1352 add $grp IO::AIO::aio_readdirx $LIBDIR, IO::AIO::READDIR_STAT_ORDER, sub {
1353 for (grep /\.ext$/, @{$_[0]}) {
1354 add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data;
1355 }
1356 };
1357
1358 $grp
1359}
1360
1311sub load_extensions { 1361sub load_extensions {
1312 cf::sync_job { 1362 cf::sync_job {
1313 my %todo; 1363 my %todo;
1314 1364
1315 for my $path (<$LIBDIR/*.ext>) { 1365 for my $path (<$LIBDIR/*.ext>) {
… …
1334 1384
1335 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 } 1385 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 }
1336 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m; 1386 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m;
1337 1387
1338 $ext{source} = 1388 $ext{source} =
1339 "package $pkg; use strict; use utf8;\n" 1389 "package $pkg; use 5.10.0; use strict 'vars', 'subs'; use utf8;\n"
1340 . "#line 1 \"$path\"\n{\n" 1390 . "#line 1 \"$path\"\n{\n"
1341 . $source 1391 . $source
1342 . "\n};\n1"; 1392 . "\n};\n1";
1343 1393
1344 $todo{$base} = \%ext; 1394 $todo{$base} = \%ext;
… …
1384 1434
1385=back 1435=back
1386 1436
1387=head2 CORE EXTENSIONS 1437=head2 CORE EXTENSIONS
1388 1438
1389Functions and methods that extend core crossfire objects. 1439Functions and methods that extend core deliantra objects.
1390 1440
1391=cut 1441=cut
1392 1442
1393package cf::player; 1443package cf::player;
1394 1444
… …
1437 1487
1438sub exists($) { 1488sub exists($) {
1439 my ($login) = @_; 1489 my ($login) = @_;
1440 1490
1441 $cf::PLAYER{$login} 1491 $cf::PLAYER{$login}
1442 or cf::sync_job { !aio_stat path $login } 1492 or !aio_stat path $login
1443} 1493}
1444 1494
1445sub find($) { 1495sub find($) {
1446 return $cf::PLAYER{$_[0]} || do { 1496 return $cf::PLAYER{$_[0]} || do {
1447 my $login = $_[0]; 1497 my $login = $_[0];
… …
1522 my ($pl) = @_; 1572 my ($pl) = @_;
1523 1573
1524 my $name = $pl->ob->name; 1574 my $name = $pl->ob->name;
1525 1575
1526 $pl->{deny_save} = 1; 1576 $pl->{deny_save} = 1;
1527 $pl->password ("*"); # this should lock out the player until we nuked the dir 1577 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1528 1578
1529 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1579 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1530 $pl->deactivate; 1580 $pl->deactivate;
1531 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1581 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1532 $pl->ob->check_score; 1582 $pl->ob->check_score;
… …
1618 } 1668 }
1619 1669
1620 \@paths 1670 \@paths
1621} 1671}
1622 1672
1623=item $protocol_xml = $player->expand_cfpod ($crossfire_pod) 1673=item $protocol_xml = $player->expand_cfpod ($cfpod)
1624 1674
1625Expand crossfire pod fragments into protocol xml. 1675Expand deliantra pod fragments into protocol xml.
1626
1627=cut
1628
1629use re 'eval';
1630
1631my $group;
1632my $interior; $interior = qr{
1633 # match a pod interior sequence sans C<< >>
1634 (?:
1635 \ (.*?)\ (?{ $group = $^N })
1636 | < (??{$interior}) >
1637 )
1638}x;
1639
1640sub expand_cfpod {
1641 my ($self, $pod) = @_;
1642
1643 my $xml;
1644
1645 while () {
1646 if ($pod =~ /\G( (?: [^BCGHITU]+ | .(?!<) )+ )/xgcs) {
1647 $group = $1;
1648
1649 $group =~ s/&/&amp;/g;
1650 $group =~ s/</&lt;/g;
1651
1652 $xml .= $group;
1653 } elsif ($pod =~ m%\G
1654 ([BCGHITU])
1655 <
1656 (?:
1657 ([^<>]*) (?{ $group = $^N })
1658 | < $interior >
1659 )
1660 >
1661 %gcsx
1662 ) {
1663 my ($code, $data) = ($1, $group);
1664
1665 if ($code eq "B") {
1666 $xml .= "<b>" . expand_cfpod ($self, $data) . "</b>";
1667 } elsif ($code eq "I") {
1668 $xml .= "<i>" . expand_cfpod ($self, $data) . "</i>";
1669 } elsif ($code eq "U") {
1670 $xml .= "<u>" . expand_cfpod ($self, $data) . "</u>";
1671 } elsif ($code eq "C") {
1672 $xml .= "<tt>" . expand_cfpod ($self, $data) . "</tt>";
1673 } elsif ($code eq "T") {
1674 $xml .= "<big><b>" . expand_cfpod ($self, $data) . "</b></big>";
1675 } elsif ($code eq "G") {
1676 my ($male, $female) = split /\|/, $data;
1677 $data = $self->gender ? $female : $male;
1678 $xml .= expand_cfpod ($self, $data);
1679 } elsif ($code eq "H") {
1680 $xml .= ("<fg name=\"lightblue\">[" . expand_cfpod ($self, $data) . " (Use hintmode to suppress hints)]</fg>",
1681 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>",
1682 "")
1683 [$self->{hintmode}];
1684 } else {
1685 $xml .= "error processing '$code($data)' directive";
1686 }
1687 } else {
1688 if ($pod =~ /\G(.+)/) {
1689 warn "parse error while expanding $pod (at $1)";
1690 }
1691 last;
1692 }
1693 }
1694
1695 for ($xml) {
1696 # create single paragraphs (very hackish)
1697 s/(?<=\S)\n(?=\w)/ /g;
1698
1699 # compress some whitespace
1700 s/\s+\n/\n/g; # ws line-ends
1701 s/\n\n+/\n/g; # double lines
1702 s/^\n+//; # beginning lines
1703 s/\n+$//; # ending lines
1704 }
1705
1706 $xml
1707}
1708
1709no re 'eval';
1710
1711sub hintmode {
1712 $_[0]{hintmode} = $_[1] if @_ > 1;
1713 $_[0]{hintmode}
1714}
1715 1676
1716=item $player->ext_reply ($msgid, @msg) 1677=item $player->ext_reply ($msgid, @msg)
1717 1678
1718Sends an ext reply to the player. 1679Sends an ext reply to the player.
1719 1680
… …
1932 1893
1933 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go; 1894 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
1934 "$UNIQUEDIR/$path" 1895 "$UNIQUEDIR/$path"
1935} 1896}
1936 1897
1937# and all this just because we cannot iterate over
1938# all maps in C++...
1939sub change_all_map_light {
1940 my ($change) = @_;
1941
1942 $_->change_map_light ($change)
1943 for grep $_->outdoor, values %cf::MAP;
1944}
1945
1946sub decay_objects { 1898sub decay_objects {
1947 my ($self) = @_; 1899 my ($self) = @_;
1948 1900
1949 return if $self->{deny_reset}; 1901 return if $self->{deny_reset};
1950 1902
… …
2032sub find { 1984sub find {
2033 my ($path, $origin) = @_; 1985 my ($path, $origin) = @_;
2034 1986
2035 $path = normalise $path, $origin && $origin->path; 1987 $path = normalise $path, $origin && $origin->path;
2036 1988
2037 cf::lock_wait "map_data:$path";#d#remove 1989 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
2038 cf::lock_wait "map_find:$path"; 1990 my $guard2 = cf::lock_acquire "map_find:$path";
2039 1991
2040 $cf::MAP{$path} || do { 1992 $cf::MAP{$path} || do {
2041 my $guard1 = cf::lock_acquire "map_data:$path"; # just for the fun of it
2042 my $guard2 = cf::lock_acquire "map_find:$path";
2043
2044 my $map = new_from_path cf::map $path 1993 my $map = new_from_path cf::map $path
2045 or return; 1994 or return;
2046 1995
2047 $map->{last_save} = $cf::RUNTIME; 1996 $map->{last_save} = $cf::RUNTIME;
2048 1997
… …
2088 my $f = new_from_file cf::object::thawer $self->{load_path}; 2037 my $f = new_from_file cf::object::thawer $self->{load_path};
2089 $f->skip_block; 2038 $f->skip_block;
2090 $self->_load_objects ($f) 2039 $self->_load_objects ($f)
2091 or return; 2040 or return;
2092 2041
2093 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) 2042 $self->post_load_original
2094 if delete $self->{load_original}; 2043 if delete $self->{load_original};
2095 2044
2096 if (my $uniq = $self->uniq_path) { 2045 if (my $uniq = $self->uniq_path) {
2097 utf8::encode $uniq; 2046 utf8::encode $uniq;
2098 unless (aio_stat $uniq) { 2047 unless (aio_stat $uniq) {
… …
2116 unless ($self->{deny_activate}) { 2065 unless ($self->{deny_activate}) {
2117 $self->decay_objects; 2066 $self->decay_objects;
2118 $self->fix_auto_apply; 2067 $self->fix_auto_apply;
2119 $self->update_buttons; 2068 $self->update_buttons;
2120 cf::cede_to_tick; 2069 cf::cede_to_tick;
2121 $self->set_darkness_map;
2122 cf::cede_to_tick;
2123 $self->activate; 2070 $self->activate;
2124 } 2071 }
2125 2072
2126 $self->{last_save} = $cf::RUNTIME; 2073 $self->{last_save} = $cf::RUNTIME;
2127 $self->last_access ($cf::RUNTIME); 2074 $self->last_access ($cf::RUNTIME);
… …
2293 2240
2294 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2241 my $lock = cf::lock_acquire "map_data:$self->{path}";
2295 2242
2296 return if $self->players; 2243 return if $self->players;
2297 2244
2298 warn "resetting map ", $self->path; 2245 warn "resetting map ", $self->path, "\n";
2299 2246
2300 $self->in_memory (cf::MAP_SWAPPED); 2247 $self->in_memory (cf::MAP_SWAPPED);
2301 2248
2302 # need to save uniques path 2249 # need to save uniques path
2303 unless ($self->{deny_save}) { 2250 unless ($self->{deny_save}) {
… …
2468 2415
2469our $SAY_CHANNEL = { 2416our $SAY_CHANNEL = {
2470 id => "say", 2417 id => "say",
2471 title => "Map", 2418 title => "Map",
2472 reply => "say ", 2419 reply => "say ",
2473 tooltip => "Things said to and replied from npcs near you and other players on the same map only.", 2420 tooltip => "Things said to and replied from NPCs near you and other players on the same map only.",
2474}; 2421};
2475 2422
2476our $CHAT_CHANNEL = { 2423our $CHAT_CHANNEL = {
2477 id => "chat", 2424 id => "chat",
2478 title => "Chat", 2425 title => "Chat",
… …
2533 2480
2534=item $player_object->enter_link 2481=item $player_object->enter_link
2535 2482
2536Freezes the player and moves him/her to a special map (C<{link}>). 2483Freezes the player and moves him/her to a special map (C<{link}>).
2537 2484
2538The player should be reasonably safe there for short amounts of time. You 2485The player should be reasonably safe there for short amounts of time (e.g.
2539I<MUST> call C<leave_link> as soon as possible, though. 2486for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2487though, as the palyer cannot control the character while it is on the link
2488map.
2540 2489
2541Will never block. 2490Will never block.
2542 2491
2543=item $player_object->leave_link ($map, $x, $y) 2492=item $player_object->leave_link ($map, $x, $y)
2544 2493
… …
2602 2551
2603 $map->load; 2552 $map->load;
2604 $map->load_neighbours; 2553 $map->load_neighbours;
2605 2554
2606 return unless $self->contr->active; 2555 return unless $self->contr->active;
2607 $self->activate_recursive;
2608 2556
2609 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2557 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2610 $self->enter_map ($map, $x, $y); 2558 $self->enter_map ($map, $x, $y);
2559
2560 # only activate afterwards, to support waiting in hooks
2561 $self->activate_recursive;
2611} 2562}
2612 2563
2613=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2564=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2614 2565
2615Moves the player to the given map-path and coordinates by first freezing 2566Moves the player to the given map-path and coordinates by first freezing
2616her, loading and preparing them map, calling the provided $check callback 2567her, loading and preparing them map, calling the provided $check callback
2617that has to return the map if sucecssful, and then unfreezes the player on 2568that has to return the map if sucecssful, and then unfreezes the player on
2618the new (success) or old (failed) map position. In either case, $done will 2569the new (success) or old (failed) map position. In either case, $done will
2619be called at the end of this process. 2570be called at the end of this process.
2571
2572Note that $check will be called with a potentially non-loaded map, so if
2573it needs a loaded map it has to call C<< ->load >>.
2620 2574
2621=cut 2575=cut
2622 2576
2623our $GOTOGEN; 2577our $GOTOGEN;
2624 2578
… …
2771 $self->contr->savebed ($map, $x, $y) 2725 $self->contr->savebed ($map, $x, $y)
2772 if $exit->flag (cf::FLAG_DAMNED); 2726 if $exit->flag (cf::FLAG_DAMNED);
2773 2727
2774 1 2728 1
2775 }) { 2729 }) {
2776 $self->message ("Something went wrong deep within the crossfire server. " 2730 $self->message ("Something went wrong deep within the deliantra server. "
2777 . "I'll try to bring you back to the map you were before. " 2731 . "I'll try to bring you back to the map you were before. "
2778 . "Please report this to the dungeon master!", 2732 . "Please report this to the dungeon master!",
2779 cf::NDI_UNIQUE | cf::NDI_RED); 2733 cf::NDI_UNIQUE | cf::NDI_RED);
2780 2734
2781 warn "ERROR in enter_exit: $@"; 2735 warn "ERROR in enter_exit: $@";
… …
2847 id => "infobox", 2801 id => "infobox",
2848 title => "Body Parts", 2802 title => "Body Parts",
2849 reply => undef, 2803 reply => undef,
2850 tooltip => "Shows which body parts you posess and are available", 2804 tooltip => "Shows which body parts you posess and are available",
2851 }, 2805 },
2806 "c/statistics" => {
2807 id => "infobox",
2808 title => "Statistics",
2809 reply => undef,
2810 tooltip => "Shows your primary statistics",
2811 },
2812 "c/skills" => {
2813 id => "infobox",
2814 title => "Skills",
2815 reply => undef,
2816 tooltip => "Shows your experience per skill and item power",
2817 },
2818 "c/shopitems" => {
2819 id => "infobox",
2820 title => "Shop Items",
2821 reply => undef,
2822 tooltip => "Shows the items currently for sale in this shop",
2823 },
2824 "c/resistances" => {
2825 id => "infobox",
2826 title => "Resistances",
2827 reply => undef,
2828 tooltip => "Shows your resistances",
2829 },
2830 "c/pets" => {
2831 id => "infobox",
2832 title => "Pets",
2833 reply => undef,
2834 tooltip => "Shows information abotu your pets/a specific pet",
2835 },
2836 "c/perceiveself" => {
2837 id => "infobox",
2838 title => "Perceive Self",
2839 reply => undef,
2840 tooltip => "You gained detailed knowledge about yourself",
2841 },
2852 "c/uptime" => { 2842 "c/uptime" => {
2853 id => "infobox", 2843 id => "infobox",
2854 title => "Uptime", 2844 title => "Uptime",
2855 reply => undef, 2845 reply => undef,
2856 tooltip => "How long the server has been running since last restart", 2846 tooltip => "How long the server has been running since last restart",
… …
2865 id => "party", 2855 id => "party",
2866 title => "Party", 2856 title => "Party",
2867 reply => "gsay ", 2857 reply => "gsay ",
2868 tooltip => "Messages and chat related to your party", 2858 tooltip => "Messages and chat related to your party",
2869 }, 2859 },
2860 "c/death" => {
2861 id => "death",
2862 title => "Death",
2863 reply => undef,
2864 tooltip => "Reason for and more info about your most recent death",
2865 },
2866 "c/say" => $SAY_CHANNEL,
2867 "c/chat" => $CHAT_CHANNEL,
2870); 2868);
2871 2869
2872sub cf::client::send_msg { 2870sub cf::client::send_msg {
2873 my ($self, $channel, $msg, $color, @extra) = @_; 2871 my ($self, $channel, $msg, $color, @extra) = @_;
2874 2872
2875 $msg = $self->pl->expand_cfpod ($msg); 2873 $msg = $self->pl->expand_cfpod ($msg)
2874 unless $color & cf::NDI_VERBATIM;
2876 2875
2877 $color &= cf::NDI_CLIENT_MASK; # just in case... 2876 $color &= cf::NDI_CLIENT_MASK; # just in case...
2878 2877
2879 # check predefined channels, for the benefit of C 2878 # check predefined channels, for the benefit of C
2880 if ($CHANNEL{$channel}) { 2879 if ($CHANNEL{$channel}) {
2881 $channel = $CHANNEL{$channel}; 2880 $channel = $CHANNEL{$channel};
2882 2881
2883 $self->ext_msg (channel_info => $channel) 2882 $self->ext_msg (channel_info => $channel);
2884 if $self->can_msg;
2885
2886 $channel = $channel->{id}; 2883 $channel = $channel->{id};
2887 2884
2888 } elsif (ref $channel) { 2885 } elsif (ref $channel) {
2889 # send meta info to client, if not yet sent 2886 # send meta info to client, if not yet sent
2890 unless (exists $self->{channel}{$channel->{id}}) { 2887 unless (exists $self->{channel}{$channel->{id}}) {
2891 $self->{channel}{$channel->{id}} = $channel; 2888 $self->{channel}{$channel->{id}} = $channel;
2892 $self->ext_msg (channel_info => $channel) 2889 $self->ext_msg (channel_info => $channel);
2893 if $self->can_msg;
2894 } 2890 }
2895 2891
2896 $channel = $channel->{id}; 2892 $channel = $channel->{id};
2897 } 2893 }
2898 2894
2899 return unless @extra || length $msg; 2895 return unless @extra || length $msg;
2900 2896
2901 if ($self->can_msg) {
2902 # default colour, mask it out 2897 # default colour, mask it out
2903 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) 2898 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
2904 if $color & cf::NDI_DEF; 2899 if $color & cf::NDI_DEF;
2905 2900
2906 $self->send_packet ("msg " . $self->{json_coder}->encode ( 2901 my $pkt = "msg "
2902 . $self->{json_coder}->encode (
2907 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra])); 2903 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2908 } else { 2904 );
2909 if ($color >= 0) {
2910 # replace some tags by gcfclient-compatible ones
2911 for ($msg) {
2912 1 while
2913 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2914 || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2915 || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2916 || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2917 || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2918 }
2919 2905
2920 $color &= cf::NDI_COLOR_MASK; 2906 # try lzf for large packets
2907 $pkt = "lzf " . Compress::LZF::compress $pkt
2908 if 1024 <= length $pkt and $self->{can_lzf};
2921 2909
2922 utf8::encode $msg; 2910 # split very large packets
2923 2911 if (8192 < length $pkt and $self->{can_lzf}) {
2924 if (0 && $msg =~ /\[/) { 2912 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2925 # COMMAND/INFO 2913 $pkt = "frag";
2926 $self->send_packet ("drawextinfo $color 10 8 $msg")
2927 } else {
2928 $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
2929 $self->send_packet ("drawinfo $color $msg")
2930 }
2931 }
2932 } 2914 }
2915
2916 $self->send_packet ($pkt);
2933} 2917}
2934 2918
2935=item $client->ext_msg ($type, @msg) 2919=item $client->ext_msg ($type, @msg)
2936 2920
2937Sends an ext event to the client. 2921Sends an ext event to the client.
… …
3112The following functions and methods are available within a safe environment: 3096The following functions and methods are available within a safe environment:
3113 3097
3114 cf::object 3098 cf::object
3115 contr pay_amount pay_player map x y force_find force_add destroy 3099 contr pay_amount pay_player map x y force_find force_add destroy
3116 insert remove name archname title slaying race decrease split 3100 insert remove name archname title slaying race decrease split
3101 value
3117 3102
3118 cf::object::player 3103 cf::object::player
3119 player 3104 player
3120 3105
3121 cf::player 3106 cf::player
… …
3127=cut 3112=cut
3128 3113
3129for ( 3114for (
3130 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 3115 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
3131 insert remove inv nrof name archname title slaying race 3116 insert remove inv nrof name archname title slaying race
3132 decrease split destroy)], 3117 decrease split destroy change_exp value msg lore send_msg)],
3133 ["cf::object::player" => qw(player)], 3118 ["cf::object::player" => qw(player)],
3134 ["cf::player" => qw(peaceful)], 3119 ["cf::player" => qw(peaceful send_msg)],
3135 ["cf::map" => qw(trigger)], 3120 ["cf::map" => qw(trigger)],
3136) { 3121) {
3137 no strict 'refs'; 3122 no strict 'refs';
3138 my ($pkg, @funs) = @$_; 3123 my ($pkg, @funs) = @$_;
3139 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 3124 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
… …
3156 my ($code, %vars) = @_; 3141 my ($code, %vars) = @_;
3157 3142
3158 my $qcode = $code; 3143 my $qcode = $code;
3159 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3144 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3160 $qcode =~ s/\n/\\n/g; 3145 $qcode =~ s/\n/\\n/g;
3146
3147 %vars = (_dummy => 0) unless %vars;
3161 3148
3162 local $_; 3149 local $_;
3163 local @safe::cf::_safe_eval_args = values %vars; 3150 local @safe::cf::_safe_eval_args = values %vars;
3164 3151
3165 my $eval = 3152 my $eval =
… …
3395 reload_treasures; 3382 reload_treasures;
3396 3383
3397 warn "finished reloading resource files\n"; 3384 warn "finished reloading resource files\n";
3398} 3385}
3399 3386
3400sub init {
3401 my $guard = freeze_mainloop;
3402
3403 reload_resources;
3404}
3405
3406sub reload_config { 3387sub reload_config {
3388 warn "reloading config file...\n";
3389
3407 open my $fh, "<:utf8", "$CONFDIR/config" 3390 open my $fh, "<:utf8", "$CONFDIR/config"
3408 or return; 3391 or return;
3409 3392
3410 local $/; 3393 local $/;
3411 *CFG = YAML::Load <$fh>; 3394 *CFG = YAML::XS::Load scalar <$fh>;
3412 3395
3413 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3396 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3414 3397
3415 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3398 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3416 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3399 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3420 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()" 3403 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
3421 and die "WARNING: m(un)lockall failed: $!\n"; 3404 and die "WARNING: m(un)lockall failed: $!\n";
3422 }; 3405 };
3423 warn $@ if $@; 3406 warn $@ if $@;
3424 } 3407 }
3408
3409 warn "finished reloading resource files\n";
3410}
3411
3412sub pidfile() {
3413 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT
3414 or die "$PIDFILE: $!";
3415 flock $fh, &Fcntl::LOCK_EX
3416 or die "$PIDFILE: flock: $!";
3417 $fh
3418}
3419
3420# make sure only one server instance is running at any one time
3421sub atomic {
3422 my $fh = pidfile;
3423
3424 my $pid = <$fh>;
3425 kill 9, $pid if $pid > 0;
3426
3427 seek $fh, 0, 0;
3428 print $fh $$;
3429}
3430
3431sub main_loop {
3432 warn "EV::loop starting\n";
3433 if (1) {
3434 EV::loop;
3435 }
3436 warn "EV::loop returned\n";
3437 goto &main_loop unless $REALLY_UNLOOP;
3425} 3438}
3426 3439
3427sub main { 3440sub main {
3441 cf::init_globals; # initialise logging
3442
3443 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3444 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3445 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3446 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3447
3448 cf::init_experience;
3449 cf::init_anim;
3450 cf::init_attackmess;
3451 cf::init_dynamic;
3452
3453 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3454
3428 # we must not ever block the main coroutine 3455 # we must not ever block the main coroutine
3429 local $Coro::idle = sub { 3456 local $Coro::idle = sub {
3430 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3457 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3431 (async { 3458 (async {
3432 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3459 $Coro::current->{desc} = "IDLE BUG HANDLER";
3433 EV::loop EV::LOOP_ONESHOT; 3460 EV::loop EV::LOOP_ONESHOT;
3434 })->prio (Coro::PRIO_MAX); 3461 })->prio (Coro::PRIO_MAX);
3435 }; 3462 };
3436 3463
3437 { 3464 evthread_start IO::AIO::poll_fileno;
3438 my $guard = freeze_mainloop; 3465
3466 cf::sync_job {
3467 reload_resources;
3439 reload_config; 3468 reload_config;
3440 db_init; 3469 db_init;
3470
3471 cf::load_settings;
3472 cf::load_materials;
3473 cf::init_uuid;
3474 cf::init_signals;
3475 cf::init_commands;
3476 cf::init_skills;
3477
3478 cf::init_beforeplay;
3479
3480 atomic;
3481
3441 load_extensions; 3482 load_extensions;
3442 3483
3443 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3484 utime time, time, $RUNTIMEFILE;
3485
3486 # no (long-running) fork's whatsoever before this point(!)
3487 use POSIX ();
3488 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3489
3490 (pop @POST_INIT)->(0) while @POST_INIT;
3444 } 3491 };
3445 3492
3446 EV::loop; 3493 main_loop;
3447} 3494}
3448 3495
3449############################################################################# 3496#############################################################################
3450# initialisation and cleanup 3497# initialisation and cleanup
3451 3498
… …
3458 }; 3505 };
3459 } 3506 }
3460} 3507}
3461 3508
3462sub write_runtime_sync { 3509sub write_runtime_sync {
3463 my $runtime = "$LOCALDIR/runtime";
3464
3465 # first touch the runtime file to show we are still running: 3510 # first touch the runtime file to show we are still running:
3466 # the fsync below can take a very very long time. 3511 # the fsync below can take a very very long time.
3467 3512
3468 IO::AIO::aio_utime $runtime, undef, undef; 3513 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef;
3469 3514
3470 my $guard = cf::lock_acquire "write_runtime"; 3515 my $guard = cf::lock_acquire "write_runtime";
3471 3516
3472 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 3517 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644
3473 or return; 3518 or return;
3474 3519
3475 my $value = $cf::RUNTIME + 90 + 10; 3520 my $value = $cf::RUNTIME + 90 + 10;
3476 # 10 is the runtime save interval, for a monotonic clock 3521 # 10 is the runtime save interval, for a monotonic clock
3477 # 60 allows for the watchdog to kill the server. 3522 # 60 allows for the watchdog to kill the server.
… …
3487 aio_utime $fh, undef, undef; 3532 aio_utime $fh, undef, undef;
3488 3533
3489 close $fh 3534 close $fh
3490 or return; 3535 or return;
3491 3536
3492 aio_rename "$runtime~", $runtime 3537 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE
3493 and return; 3538 and return;
3494 3539
3495 warn "runtime file written.\n"; 3540 warn "runtime file written.\n";
3496 3541
3497 1 3542 1
… …
3509 my $uuid = "$LOCALDIR/uuid"; 3554 my $uuid = "$LOCALDIR/uuid";
3510 3555
3511 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644 3556 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3512 or return; 3557 or return;
3513 3558
3514 my $value = uuid_str $uuid_skip + uuid_seq uuid_cur; 3559 my $value = uuid_seq uuid_cur;
3560
3561 unless ($value) {
3562 warn "cowardly refusing to write zero uuid value!\n";
3563 return;
3564 }
3565
3566 my $value = uuid_str $value + $uuid_skip;
3515 $uuid_skip = 0; 3567 $uuid_skip = 0;
3516 3568
3517 (aio_write $fh, 0, (length $value), $value, 0) <= 0 3569 (aio_write $fh, 0, (length $value), $value, 0) <= 0
3518 and return; 3570 and return;
3519 3571
… …
3541} 3593}
3542 3594
3543sub emergency_save() { 3595sub emergency_save() {
3544 my $freeze_guard = cf::freeze_mainloop; 3596 my $freeze_guard = cf::freeze_mainloop;
3545 3597
3546 warn "enter emergency perl save\n"; 3598 warn "emergency_perl_save: enter\n";
3547 3599
3548 cf::sync_job { 3600 cf::sync_job {
3601 # this is a trade-off: we want to be very quick here, so
3602 # save all maps without fsync, and later call a global sync
3603 # (which in turn might be very very slow)
3604 local $USE_FSYNC = 0;
3605
3549 # use a peculiar iteration method to avoid tripping on perl 3606 # use a peculiar iteration method to avoid tripping on perl
3550 # refcount bugs in for. also avoids problems with players 3607 # refcount bugs in for. also avoids problems with players
3551 # and maps saved/destroyed asynchronously. 3608 # and maps saved/destroyed asynchronously.
3552 warn "begin emergency player save\n"; 3609 warn "emergency_perl_save: begin player save\n";
3553 for my $login (keys %cf::PLAYER) { 3610 for my $login (keys %cf::PLAYER) {
3554 my $pl = $cf::PLAYER{$login} or next; 3611 my $pl = $cf::PLAYER{$login} or next;
3555 $pl->valid or next; 3612 $pl->valid or next;
3556 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt 3613 delete $pl->{unclean_save}; # not strictly necessary, but cannot hurt
3557 $pl->save; 3614 $pl->save;
3558 } 3615 }
3559 warn "end emergency player save\n"; 3616 warn "emergency_perl_save: end player save\n";
3560 3617
3561 warn "begin emergency map save\n"; 3618 warn "emergency_perl_save: begin map save\n";
3562 for my $path (keys %cf::MAP) { 3619 for my $path (keys %cf::MAP) {
3563 my $map = $cf::MAP{$path} or next; 3620 my $map = $cf::MAP{$path} or next;
3564 $map->valid or next; 3621 $map->valid or next;
3565 $map->save; 3622 $map->save;
3566 } 3623 }
3567 warn "end emergency map save\n"; 3624 warn "emergency_perl_save: end map save\n";
3568 3625
3569 warn "begin emergency database checkpoint\n"; 3626 warn "emergency_perl_save: begin database checkpoint\n";
3570 BDB::db_env_txn_checkpoint $DB_ENV; 3627 BDB::db_env_txn_checkpoint $DB_ENV;
3571 warn "end emergency database checkpoint\n"; 3628 warn "emergency_perl_save: end database checkpoint\n";
3572 3629
3573 warn "begin write uuid\n"; 3630 warn "emergency_perl_save: begin write uuid\n";
3574 write_uuid_sync 1; 3631 write_uuid_sync 1;
3575 warn "end write uuid\n"; 3632 warn "emergency_perl_save: end write uuid\n";
3576 }; 3633 };
3577 3634
3635 warn "emergency_perl_save: starting sync()\n";
3636 IO::AIO::aio_sync sub {
3637 warn "emergency_perl_save: finished sync()\n";
3638 };
3639
3578 warn "leave emergency perl save\n"; 3640 warn "emergency_perl_save: leave\n";
3579} 3641}
3580 3642
3581sub post_cleanup { 3643sub post_cleanup {
3582 my ($make_core) = @_; 3644 my ($make_core) = @_;
3583 3645
3584 warn Carp::longmess "post_cleanup backtrace" 3646 warn Carp::longmess "post_cleanup backtrace"
3585 if $make_core; 3647 if $make_core;
3648
3649 my $fh = pidfile;
3650 unlink $PIDFILE if <$fh> == $$;
3651}
3652
3653# a safer delete_package, copied from Symbol
3654sub clear_package($) {
3655 my $pkg = shift;
3656
3657 # expand to full symbol table name if needed
3658 unless ($pkg =~ /^main::.*::$/) {
3659 $pkg = "main$pkg" if $pkg =~ /^::/;
3660 $pkg = "main::$pkg" unless $pkg =~ /^main::/;
3661 $pkg .= '::' unless $pkg =~ /::$/;
3662 }
3663
3664 my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
3665 my $stem_symtab = *{$stem}{HASH};
3666
3667 defined $stem_symtab and exists $stem_symtab->{$leaf}
3668 or return;
3669
3670 # clear all symbols
3671 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3672 for my $name (keys %$leaf_symtab) {
3673 _gv_clear *{"$pkg$name"};
3674# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3675 }
3676 warn "cleared package $pkg\n";#d#
3586} 3677}
3587 3678
3588sub do_reload_perl() { 3679sub do_reload_perl() {
3589 # can/must only be called in main 3680 # can/must only be called in main
3590 if ($Coro::current != $Coro::main) { 3681 if ($Coro::current != $Coro::main) {
3591 warn "can only reload from main coroutine"; 3682 warn "can only reload from main coroutine";
3592 return; 3683 return;
3593 } 3684 }
3594 3685
3686 return if $RELOAD++;
3687
3688 my $t1 = EV::time;
3689
3690 while ($RELOAD) {
3595 warn "reloading..."; 3691 warn "reloading...";
3596 3692
3597 warn "entering sync_job"; 3693 warn "entering sync_job";
3598 3694
3599 cf::sync_job { 3695 cf::sync_job {
3600 cf::write_runtime_sync; # external watchdog should not bark 3696 cf::write_runtime_sync; # external watchdog should not bark
3601 cf::emergency_save; 3697 cf::emergency_save;
3602 cf::write_runtime_sync; # external watchdog should not bark 3698 cf::write_runtime_sync; # external watchdog should not bark
3603 3699
3604 warn "syncing database to disk"; 3700 warn "syncing database to disk";
3605 BDB::db_env_txn_checkpoint $DB_ENV; 3701 BDB::db_env_txn_checkpoint $DB_ENV;
3606 3702
3607 # if anything goes wrong in here, we should simply crash as we already saved 3703 # if anything goes wrong in here, we should simply crash as we already saved
3608 3704
3609 warn "flushing outstanding aio requests"; 3705 warn "flushing outstanding aio requests";
3610 for (;;) {
3611 BDB::flush;
3612 IO::AIO::flush;
3613 Coro::cede_notself;
3614 last unless IO::AIO::nreqs || BDB::nreqs; 3706 while (IO::AIO::nreqs || BDB::nreqs) {
3615 warn "iterate..."; 3707 Coro::EV::timer_once 0.01; # let the sync_job do it's thing
3616 }
3617
3618 ++$RELOAD;
3619
3620 warn "cancelling all extension coros";
3621 $_->cancel for values %EXT_CORO;
3622 %EXT_CORO = ();
3623
3624 warn "removing commands";
3625 %COMMAND = ();
3626
3627 warn "removing ext/exti commands";
3628 %EXTCMD = ();
3629 %EXTICMD = ();
3630
3631 warn "unloading/nuking all extensions";
3632 for my $pkg (@EXTS) {
3633 warn "... unloading $pkg";
3634
3635 if (my $cb = $pkg->can ("unload")) {
3636 eval {
3637 $cb->($pkg);
3638 1
3639 } or warn "$pkg unloaded, but with errors: $@";
3640 } 3708 }
3641 3709
3642 warn "... nuking $pkg"; 3710 warn "cancelling all extension coros";
3643 Symbol::delete_package $pkg; 3711 $_->cancel for values %EXT_CORO;
3644 } 3712 %EXT_CORO = ();
3645 3713
3646 warn "unloading all perl modules loaded from $LIBDIR"; 3714 warn "removing commands";
3647 while (my ($k, $v) = each %INC) { 3715 %COMMAND = ();
3648 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3649 3716
3717 warn "removing ext/exti commands";
3718 %EXTCMD = ();
3719 %EXTICMD = ();
3720
3721 warn "unloading/nuking all extensions";
3722 for my $pkg (@EXTS) {
3650 warn "... unloading $k"; 3723 warn "... unloading $pkg";
3651 delete $INC{$k};
3652 3724
3653 $k =~ s/\.pm$//;
3654 $k =~ s/\//::/g;
3655
3656 if (my $cb = $k->can ("unload_module")) { 3725 if (my $cb = $pkg->can ("unload")) {
3726 eval {
3657 $cb->(); 3727 $cb->($pkg);
3728 1
3729 } or warn "$pkg unloaded, but with errors: $@";
3730 }
3731
3732 warn "... clearing $pkg";
3733 clear_package $pkg;
3658 } 3734 }
3659 3735
3660 Symbol::delete_package $k; 3736 warn "unloading all perl modules loaded from $LIBDIR";
3737 while (my ($k, $v) = each %INC) {
3738 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3739
3740 warn "... unloading $k";
3741 delete $INC{$k};
3742
3743 $k =~ s/\.pm$//;
3744 $k =~ s/\//::/g;
3745
3746 if (my $cb = $k->can ("unload_module")) {
3747 $cb->();
3748 }
3749
3750 clear_package $k;
3661 } 3751 }
3662 3752
3663 warn "getting rid of safe::, as good as possible"; 3753 warn "getting rid of safe::, as good as possible";
3664 Symbol::delete_package "safe::$_" 3754 clear_package "safe::$_"
3665 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 3755 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
3666 3756
3667 warn "unloading cf.pm \"a bit\""; 3757 warn "unloading cf.pm \"a bit\"";
3668 delete $INC{"cf.pm"}; 3758 delete $INC{"cf.pm"};
3669 delete $INC{"cf/pod.pm"}; 3759 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
3670 3760
3671 # don't, removes xs symbols, too, 3761 # don't, removes xs symbols, too,
3672 # and global variables created in xs 3762 # and global variables created in xs
3673 #Symbol::delete_package __PACKAGE__; 3763 #clear_package __PACKAGE__;
3674 3764
3675 warn "unload completed, starting to reload now"; 3765 warn "unload completed, starting to reload now";
3676 3766
3677 warn "reloading cf.pm"; 3767 warn "reloading cf.pm";
3678 require cf; 3768 require cf;
3679 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3769 cf::_connect_to_perl_1;
3680 3770
3681 warn "loading config and database again"; 3771 warn "loading config and database again";
3682 cf::reload_config; 3772 cf::reload_config;
3683 3773
3684 warn "loading extensions"; 3774 warn "loading extensions";
3685 cf::load_extensions; 3775 cf::load_extensions;
3686 3776
3777 if ($REATTACH_ON_RELOAD) {
3687 warn "reattaching attachments to objects/players"; 3778 warn "reattaching attachments to objects/players";
3688 _global_reattach; # objects, sockets 3779 _global_reattach; # objects, sockets
3689 warn "reattaching attachments to maps"; 3780 warn "reattaching attachments to maps";
3690 reattach $_ for values %MAP; 3781 reattach $_ for values %MAP;
3691 warn "reattaching attachments to players"; 3782 warn "reattaching attachments to players";
3692 reattach $_ for values %PLAYER; 3783 reattach $_ for values %PLAYER;
3784 }
3693 3785
3786 warn "running post_init jobs";
3787 (pop @POST_INIT)->(1) while @POST_INIT;
3788
3694 warn "leaving sync_job"; 3789 warn "leaving sync_job";
3695 3790
3696 1 3791 1
3697 } or do { 3792 } or do {
3698 warn $@; 3793 warn $@;
3699 cf::cleanup "error while reloading, exiting."; 3794 cf::cleanup "error while reloading, exiting.";
3700 }; 3795 };
3701 3796
3702 warn "reloaded"; 3797 warn "reloaded";
3798 --$RELOAD;
3799 }
3800
3801 $t1 = EV::time - $t1;
3802 warn "reload completed in ${t1}s\n";
3703}; 3803};
3704 3804
3705our $RELOAD_WATCHER; # used only during reload 3805our $RELOAD_WATCHER; # used only during reload
3706 3806
3707sub reload_perl() { 3807sub reload_perl() {
3708 # doing reload synchronously and two reloads happen back-to-back, 3808 # doing reload synchronously and two reloads happen back-to-back,
3709 # coro crashes during coro_state_free->destroy here. 3809 # coro crashes during coro_state_free->destroy here.
3710 3810
3811 $RELOAD_WATCHER ||= cf::async {
3812 Coro::AIO::aio_wait cache_extensions;
3813
3711 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3814 $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub {
3712 do_reload_perl; 3815 do_reload_perl;
3713 undef $RELOAD_WATCHER; 3816 undef $RELOAD_WATCHER;
3817 };
3714 }; 3818 };
3715} 3819}
3716 3820
3717register_command "reload" => sub { 3821register_command "reload" => sub {
3718 my ($who, $arg) = @_; 3822 my ($who, $arg) = @_;
… …
3793 BDB::max_poll_reqs $TICK * 0.1; 3897 BDB::max_poll_reqs $TICK * 0.1;
3794 $AnyEvent::BDB::WATCHER->priority (1); 3898 $AnyEvent::BDB::WATCHER->priority (1);
3795 3899
3796 unless ($DB_ENV) { 3900 unless ($DB_ENV) {
3797 $DB_ENV = BDB::db_env_create; 3901 $DB_ENV = BDB::db_env_create;
3798 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3902 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
3799 | BDB::LOG_AUTOREMOVE, 1); 3903 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;
3904 $DB_ENV->log_set_config (&BDB::LOG_AUTO_REMOVE) if BDB::VERSION v4.7;
3800 $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT); 3905 $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT);
3801 $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT); 3906 $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT);
3802 3907
3803 cf::sync_job { 3908 cf::sync_job {
3804 eval { 3909 eval {
… …
3830{ 3935{
3831 # configure IO::AIO 3936 # configure IO::AIO
3832 3937
3833 IO::AIO::min_parallel 8; 3938 IO::AIO::min_parallel 8;
3834 IO::AIO::max_poll_time $TICK * 0.1; 3939 IO::AIO::max_poll_time $TICK * 0.1;
3835 #undef $AnyEvent::AIO::WATCHER; 3940 undef $AnyEvent::AIO::WATCHER;
3836} 3941}
3837 3942
3838my $_log_backtrace; 3943my $_log_backtrace;
3839 3944
3840sub _log_backtrace { 3945sub _log_backtrace {
… …
3843 $msg =~ s/\n//; 3948 $msg =~ s/\n//;
3844 3949
3845 # limit the # of concurrent backtraces 3950 # limit the # of concurrent backtraces
3846 if ($_log_backtrace < 2) { 3951 if ($_log_backtrace < 2) {
3847 ++$_log_backtrace; 3952 ++$_log_backtrace;
3953 my $perl_bt = Carp::longmess $msg;
3848 async { 3954 async {
3849 $Coro::current->{desc} = "abt $msg"; 3955 $Coro::current->{desc} = "abt $msg";
3850 3956
3851 my @bt = fork_call { 3957 my @bt = fork_call {
3852 @addr = map { sprintf "%x", $_ } @addr; 3958 @addr = map { sprintf "%x", $_ } @addr;
… …
3863 } 3969 }
3864 3970
3865 @funcs 3971 @funcs
3866 }; 3972 };
3867 3973
3868 LOG llevInfo, "[ABT] $msg\n"; 3974 LOG llevInfo, "[ABT] $perl_bt\n";
3975 LOG llevInfo, "[ABT] --- C backtrace follows ---\n";
3869 LOG llevInfo, "[ABT] $_\n" for @bt; 3976 LOG llevInfo, "[ABT] $_\n" for @bt;
3870 --$_log_backtrace; 3977 --$_log_backtrace;
3871 }; 3978 };
3872 } else { 3979 } else {
3873 LOG llevInfo, "[ABT] $msg\n"; 3980 LOG llevInfo, "[ABT] $msg\n";
3874 LOG llevInfo, "[ABT] [suppressed]\n"; 3981 LOG llevInfo, "[ABT] [suppressed]\n";
3875 } 3982 }
3876} 3983}
3877 3984
3878# load additional modules 3985# load additional modules
3879use cf::pod; 3986require "cf/$_.pm" for @EXTRA_MODULES;
3987cf::_connect_to_perl_2;
3880 3988
3881END { cf::emergency_save } 3989END { cf::emergency_save }
3882 3990
3883evthread_start IO::AIO::poll_fileno;
3884
38851 39911
3886 3992

Diff Legend

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