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.105 by root, Sun Dec 31 17:17:23 2006 UTC vs.
Revision 1.108 by root, Sun Dec 31 21:02:05 2006 UTC

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 Digest::MD5;
20use Fcntl; 21use Fcntl;
21use IO::AIO 2.31 (); 22use IO::AIO 2.31 ();
22use YAML::Syck (); 23use YAML::Syck ();
23use Time::HiRes; 24use Time::HiRes;
24 25
49our $RUNTIME; 50our $RUNTIME;
50 51
51our %MAP; # all maps 52our %MAP; # all maps
52our $LINK_MAP; # the special {link} map 53our $LINK_MAP; # the special {link} map
53our $FREEZE; 54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO;
54 57
55binmode STDOUT; 58binmode STDOUT;
56binmode STDERR; 59binmode STDERR;
57 60
58# read virtual server time, if available 61# read virtual server time, if available
64 67
65mkdir cf::localdir; 68mkdir cf::localdir;
66mkdir cf::localdir . "/" . cf::playerdir; 69mkdir cf::localdir . "/" . cf::playerdir;
67mkdir cf::localdir . "/" . cf::tmpdir; 70mkdir cf::localdir . "/" . cf::tmpdir;
68mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS;
69 73
70our %EXT_CORO; 74# a special map that is always available
75our $LINK_MAP;
71 76
72############################################################################# 77#############################################################################
73 78
74=head2 GLOBAL VARIABLES 79=head2 GLOBAL VARIABLES
75 80
174sub to_json($) { 179sub to_json($) {
175 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
176 JSON::Syck::Dump $_[0] 181 JSON::Syck::Dump $_[0]
177} 182}
178 183
179# main coro must never ever "block" except in Event 184=item cf::sync_job { BLOCK }
180# sync_job ensures this by running the job in a coroutine 185
181# and waiting in Event while the server is otherwise frozen 186The design of crossfire+ requires that the main coro ($Coro::main) is
187always able to handle events or runnable, as crossfire+ is only partly
188reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
189
190If it must be done, put the blocking parts into C<sync_job>. This will run
191the given BLOCK in another coroutine while waiting for the result. The
192server will be frozen during this time, so the block should either finish
193fast or be very important.
194
195=cut
196
182sub sync_job(&) { 197sub sync_job(&) {
183 my ($job) = @_; 198 my ($job) = @_;
184 199
185 my $busy = 1; 200 my $busy = 1;
186 my @res; 201 my @res;
187 202
203 # TODO: use suspend/resume instead
188 local $FREEZE = 1; 204 local $FREEZE = 1;
189 205
190 my $coro = Coro::async { 206 my $coro = Coro::async {
191 @res = eval { $job->() }; 207 @res = eval { $job->() };
192 warn $@ if $@; 208 warn $@ if $@;
229 $EXT_CORO{$coro+0} = $coro; 245 $EXT_CORO{$coro+0} = $coro;
230 246
231 $coro 247 $coro
232} 248}
233 249
250sub write_runtime {
251 my $runtime = cf::localdir . "/runtime";
252
253 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
254 or return;
255
256 my $value = $cf::RUNTIME;
257 (aio_write $fh, 0, (length $value), $value, 0) <= 0
258 and return;
259
260 aio_fsync $fh
261 and return;
262
263 close $fh
264 or return;
265
266 aio_rename "$runtime~", $runtime
267 and return;
268
269 1
270}
271
234=back 272=back
235 273
236=cut 274=cut
275
276#############################################################################
277
278package cf::path;
279
280sub new {
281 my ($class, $path, $base) = @_;
282
283 my $self = bless { }, $class;
284
285 if ($path =~ s{^\?random/}{}) {
286 $self->{random} = cf::from_json $path;
287 } else {
288 if ($path =~ s{^~([^/]+)?}{}) {
289 $self->{user_rel} = 1;
290
291 if (defined $1) {
292 $self->{user} = $1;
293 } elsif ($base =~ m{^~([^/]+)/}) {
294 $self->{user} = $1;
295 } else {
296 warn "cannot resolve user-relative path without user <$path,$base>\n";
297 }
298 } elsif ($path =~ /^\//) {
299 # already absolute
300 } else {
301 $base =~ s{[^/]+/?$}{};
302 return $class->new ("$base/$path");
303 }
304
305 for ($path) {
306 redo if s{/\.?/}{/};
307 redo if s{/[^/]+/\.\./}{/};
308 }
309 }
310
311 $self->{path} = $path;
312
313 $self
314}
315
316# the name / primary key / in-game path
317sub as_string {
318 my ($self) = @_;
319
320 $self->{user_rel} ? "~$self->{user}$self->{path}"
321 : $self->{random} ? "?random/$self->{path}"
322 : $self->{path}
323}
324
325# the displayed name, this is a one way mapping
326sub visible_name {
327 my ($self) = @_;
328
329 $self->{random} ? "?random/$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}/$self->{random}{dungeon_level}"
330 : $self->as_string
331}
332
333# escape the /'s in the path
334sub _escaped_path {
335 # ∕ is U+2215
336 (my $path = $_[0]{path}) =~ s/\//∕/g;
337 $path
338}
339
340# the original (read-only) location
341sub load_path {
342 my ($self) = @_;
343
344 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
345}
346
347# the temporary/swap location
348sub save_path {
349 my ($self) = @_;
350
351 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
352 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, Digest::MD5::md5_hex $self->{path}
353 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
354}
355
356# the unique path, might be eq to save_path
357sub uniq_path {
358 my ($self) = @_;
359
360 $self->{user_rel} || $self->{random}
361 ? undef
362 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
363}
364
365# return random map parameters, or undef
366sub random_map_params {
367 my ($self) = @_;
368
369 $self->{random}
370}
371
372# this is somewhat ugly, but style maps do need special treatment
373sub is_style_map {
374 $_[0]{path} =~ m{^/styles/}
375}
376
377package cf;
237 378
238############################################################################# 379#############################################################################
239 380
240=head2 ATTACHABLE OBJECTS 381=head2 ATTACHABLE OBJECTS
241 382
1261 local $/; 1402 local $/;
1262 *CFG = YAML::Syck::Load <$fh>; 1403 *CFG = YAML::Syck::Load <$fh>;
1263} 1404}
1264 1405
1265sub main { 1406sub main {
1407 # we must not ever block the main coroutine
1408 local $Coro::idle = sub {
1409 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1410 (Coro::unblock_sub {
1411 Event::one_event;
1412 })->();
1413 };
1414
1266 cfg_load; 1415 cfg_load;
1267 db_load; 1416 db_load;
1268 load_extensions; 1417 load_extensions;
1269 Event::loop; 1418 Event::loop;
1270} 1419}
1271 1420
1272############################################################################# 1421#############################################################################
1273# initialisation 1422# initialisation
1274 1423
1275sub _perl_reload() { 1424sub perl_reload() {
1425 # can/must only be called in main
1426 if ($Coro::current != $Coro::main) {
1427 warn "can only reload from main coroutine\n";
1428 return;
1429 }
1430
1276 warn "reloading..."; 1431 warn "reloading...";
1277 1432
1433 local $FREEZE = 1;
1434 cf::emergency_save;
1435
1278 eval { 1436 eval {
1279 local $FREEZE = 1; 1437 # if anything goes wrong in here, we should simply crash as we already saved
1280
1281 cf::emergency_save;
1282 1438
1283 # cancel all watchers 1439 # cancel all watchers
1284 for (Event::all_watchers) { 1440 for (Event::all_watchers) {
1285 $_->cancel if $_->data & WF_AUTOCANCEL; 1441 $_->cancel if $_->data & WF_AUTOCANCEL;
1286 } 1442 }
1345 1501
1346 # reattach attachments to objects 1502 # reattach attachments to objects
1347 warn "reattach"; 1503 warn "reattach";
1348 _global_reattach; 1504 _global_reattach;
1349 }; 1505 };
1350 warn $@ if $@;
1351 1506
1352 warn "reloaded"; 1507 if ($@) {
1508 warn $@;
1509 warn "error while reloading, exiting.";
1510 exit 1;
1511 }
1512
1513 warn "reloaded successfully";
1353}; 1514};
1354 1515
1355sub perl_reload() { 1516#############################################################################
1356 _perl_reload; 1517
1518unless ($LINK_MAP) {
1519 $LINK_MAP = cf::map::new;
1520
1521 $LINK_MAP->width (41);
1522 $LINK_MAP->height (41);
1523 $LINK_MAP->alloc;
1524 $LINK_MAP->path ("{link}");
1525 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1526 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1357} 1527}
1358 1528
1359register "<global>", __PACKAGE__; 1529register "<global>", __PACKAGE__;
1360 1530
1361register_command "perl-reload" => sub { 1531register_command "perl-reload" => sub {
1362 my ($who, $arg) = @_; 1532 my ($who, $arg) = @_;
1363 1533
1364 if ($who->flag (FLAG_WIZ)) { 1534 if ($who->flag (FLAG_WIZ)) {
1365 $who->message ("reloading..."); 1535 $who->message ("start of reload.");
1366 _perl_reload; 1536 perl_reload;
1537 $who->message ("end of reload.");
1367 } 1538 }
1368}; 1539};
1369 1540
1370unshift @INC, $LIBDIR; 1541unshift @INC, $LIBDIR;
1371 1542
1390 }, 1561 },
1391); 1562);
1392 1563
1393IO::AIO::max_poll_time $TICK * 0.2; 1564IO::AIO::max_poll_time $TICK * 0.2;
1394 1565
1566Event->io (
1395Event->io (fd => IO::AIO::poll_fileno, 1567 fd => IO::AIO::poll_fileno,
1396 poll => 'r', 1568 poll => 'r',
1397 prio => 5, 1569 prio => 5,
1398 data => WF_AUTOCANCEL, 1570 data => WF_AUTOCANCEL,
1399 cb => \&IO::AIO::poll_cb); 1571 cb => \&IO::AIO::poll_cb,
1572);
1400 1573
1401# we must not ever block the main coroutine 1574Event->timer (
1402$Coro::idle = sub { 1575 data => WF_AUTOCANCEL,
1403 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1576 after => 0,
1404 warn "FATAL: Coro::idle was called, major BUG\n"; 1577 interval => 10,
1578 cb => sub {
1405 (Coro::unblock_sub { 1579 (Coro::unblock_sub {
1406 Event::one_event; 1580 write_runtime
1581 or warn "ERROR: unable to write runtime file: $!";
1407 })->(); 1582 })->();
1408}; 1583 },
1584);
1409 1585
14101 15861
1411 1587

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines