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.109 by root, Sun Dec 31 22:23:12 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 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
287 $self->{random} = cf::from_json $data;
288 } else {
289 if ($path =~ s{^~([^/]+)?}{}) {
290 $self->{user_rel} = 1;
291
292 if (defined $1) {
293 $self->{user} = $1;
294 } elsif ($base =~ m{^~([^/]+)/}) {
295 $self->{user} = $1;
296 } else {
297 warn "cannot resolve user-relative path without user <$path,$base>\n";
298 }
299 } elsif ($path =~ /^\//) {
300 # already absolute
301 } else {
302 $base =~ s{[^/]+/?$}{};
303 return $class->new ("$base/$path");
304 }
305
306 for ($path) {
307 redo if s{/\.?/}{/};
308 redo if s{/[^/]+/\.\./}{/};
309 }
310 }
311
312 $self->{path} = $path;
313
314 $self
315}
316
317# the name / primary key / in-game path
318sub as_string {
319 my ($self) = @_;
320
321 $self->{user_rel} ? "~$self->{user}$self->{path}"
322 : $self->{random} ? "?random/$self->{path}"
323 : $self->{path}
324}
325
326# the displayed name, this is a one way mapping
327sub visible_name {
328 my ($self) = @_;
329
330# if (my $rmp = $self->{random}) {
331# # todo: be more intelligent about this
332# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
333# } else {
334 $self->as_string
335# }
336}
337
338# escape the /'s in the path
339sub _escaped_path {
340 # ∕ is U+2215
341 (my $path = $_[0]{path}) =~ s/\//∕/g;
342 $path
343}
344
345# the original (read-only) location
346sub load_path {
347 my ($self) = @_;
348
349 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
350}
351
352# the temporary/swap location
353sub save_path {
354 my ($self) = @_;
355
356 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
357 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
358 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
359}
360
361# the unique path, might be eq to save_path
362sub uniq_path {
363 my ($self) = @_;
364
365 $self->{user_rel} || $self->{random}
366 ? undef
367 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
368}
369
370# return random map parameters, or undef
371sub random_map_params {
372 my ($self) = @_;
373
374 $self->{random}
375}
376
377# this is somewhat ugly, but style maps do need special treatment
378sub is_style_map {
379 $_[0]{path} =~ m{^/styles/}
380}
381
382package cf;
237 383
238############################################################################# 384#############################################################################
239 385
240=head2 ATTACHABLE OBJECTS 386=head2 ATTACHABLE OBJECTS
241 387
… …
1261 local $/; 1407 local $/;
1262 *CFG = YAML::Syck::Load <$fh>; 1408 *CFG = YAML::Syck::Load <$fh>;
1263} 1409}
1264 1410
1265sub main { 1411sub main {
1412 # we must not ever block the main coroutine
1413 local $Coro::idle = sub {
1414 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1415 (Coro::unblock_sub {
1416 Event::one_event;
1417 })->();
1418 };
1419
1266 cfg_load; 1420 cfg_load;
1267 db_load; 1421 db_load;
1268 load_extensions; 1422 load_extensions;
1269 Event::loop; 1423 Event::loop;
1270} 1424}
1271 1425
1272############################################################################# 1426#############################################################################
1273# initialisation 1427# initialisation
1274 1428
1275sub _perl_reload() { 1429sub perl_reload() {
1430 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n";
1433 return;
1434 }
1435
1276 warn "reloading..."; 1436 warn "reloading...";
1277 1437
1438 local $FREEZE = 1;
1439 cf::emergency_save;
1440
1278 eval { 1441 eval {
1279 local $FREEZE = 1; 1442 # if anything goes wrong in here, we should simply crash as we already saved
1280
1281 cf::emergency_save;
1282 1443
1283 # cancel all watchers 1444 # cancel all watchers
1284 for (Event::all_watchers) { 1445 for (Event::all_watchers) {
1285 $_->cancel if $_->data & WF_AUTOCANCEL; 1446 $_->cancel if $_->data & WF_AUTOCANCEL;
1286 } 1447 }
… …
1345 1506
1346 # reattach attachments to objects 1507 # reattach attachments to objects
1347 warn "reattach"; 1508 warn "reattach";
1348 _global_reattach; 1509 _global_reattach;
1349 }; 1510 };
1350 warn $@ if $@;
1351 1511
1352 warn "reloaded"; 1512 if ($@) {
1513 warn $@;
1514 warn "error while reloading, exiting.";
1515 exit 1;
1516 }
1517
1518 warn "reloaded successfully";
1353}; 1519};
1354 1520
1355sub perl_reload() { 1521#############################################################################
1356 _perl_reload; 1522
1523unless ($LINK_MAP) {
1524 $LINK_MAP = cf::map::new;
1525
1526 $LINK_MAP->width (41);
1527 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1357} 1532}
1358 1533
1359register "<global>", __PACKAGE__; 1534register "<global>", __PACKAGE__;
1360 1535
1361register_command "perl-reload" => sub { 1536register_command "perl-reload" => sub {
1362 my ($who, $arg) = @_; 1537 my ($who, $arg) = @_;
1363 1538
1364 if ($who->flag (FLAG_WIZ)) { 1539 if ($who->flag (FLAG_WIZ)) {
1365 $who->message ("reloading..."); 1540 $who->message ("start of reload.");
1366 _perl_reload; 1541 perl_reload;
1542 $who->message ("end of reload.");
1367 } 1543 }
1368}; 1544};
1369 1545
1370unshift @INC, $LIBDIR; 1546unshift @INC, $LIBDIR;
1371 1547
… …
1390 }, 1566 },
1391); 1567);
1392 1568
1393IO::AIO::max_poll_time $TICK * 0.2; 1569IO::AIO::max_poll_time $TICK * 0.2;
1394 1570
1571Event->io (
1395Event->io (fd => IO::AIO::poll_fileno, 1572 fd => IO::AIO::poll_fileno,
1396 poll => 'r', 1573 poll => 'r',
1397 prio => 5, 1574 prio => 5,
1398 data => WF_AUTOCANCEL, 1575 data => WF_AUTOCANCEL,
1399 cb => \&IO::AIO::poll_cb); 1576 cb => \&IO::AIO::poll_cb,
1577);
1400 1578
1401# we must not ever block the main coroutine 1579Event->timer (
1402$Coro::idle = sub { 1580 data => WF_AUTOCANCEL,
1403 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1581 after => 0,
1404 warn "FATAL: Coro::idle was called, major BUG\n"; 1582 interval => 10,
1583 cb => sub {
1405 (Coro::unblock_sub { 1584 (Coro::unblock_sub {
1406 Event::one_event; 1585 write_runtime
1586 or warn "ERROR: unable to write runtime file: $!";
1407 })->(); 1587 })->();
1408}; 1588 },
1589);
1409 1590
14101 15911
1411 1592

Diff Legend

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