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.514 by root, Mon Apr 12 17:13:36 2010 UTC vs.
Revision 1.527 by root, Fri Apr 23 04:32:47 2010 UTC

… …
108our $PIDFILE = "$LOCALDIR/pid"; 108our $PIDFILE = "$LOCALDIR/pid";
109our $RUNTIMEFILE = "$LOCALDIR/runtime"; 109our $RUNTIMEFILE = "$LOCALDIR/runtime";
110 110
111our %RESOURCE; 111our %RESOURCE;
112 112
113our $OUTPUT_RATE_MIN = 4000; 113our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 100000; 114our $OUTPUT_RATE_MAX = 1000000;
115
116our $MAX_LINKS = 32; # how many chained exits to follow
117our $VERBOSE_IO = 0;#d#
115 118
116our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 119our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
117our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 120our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
118our $NEXT_TICK; 121our $NEXT_TICK;
119our $USE_FSYNC = 1; # use fsync to write maps - default on 122our $USE_FSYNC = 1; # use fsync to write maps - default on
… …
165 168
166our $EMERGENCY_POSITION; 169our $EMERGENCY_POSITION;
167 170
168sub cf::map::normalise; 171sub cf::map::normalise;
169 172
173sub in_main() {
174 $Coro::current == $Coro::main
175}
176
170############################################################################# 177#############################################################################
171 178
172%REFLECT = (); 179%REFLECT = ();
173for (@REFLECT) { 180for (@REFLECT) {
174 my $reflect = JSON::XS::decode_json $_; 181 my $reflect = JSON::XS::decode_json $_;
… …
261$Coro::State::DIEHOOK = sub { 268$Coro::State::DIEHOOK = sub {
262 return unless $^S eq 0; # "eq", not "==" 269 return unless $^S eq 0; # "eq", not "=="
263 270
264 warn Carp::longmess $_[0]; 271 warn Carp::longmess $_[0];
265 272
266 if ($Coro::current == $Coro::main) {#d# 273 if (in_main) {#d#
267 warn "DIEHOOK called in main context, Coro bug?\n";#d# 274 warn "DIEHOOK called in main context, Coro bug?\n";#d#
268 return;#d# 275 return;#d#
269 }#d# 276 }#d#
270 277
271 # kill coroutine otherwise 278 # kill coroutine otherwise
… …
1188 1195
1189 sync_job { 1196 sync_job {
1190 if (length $$rdata) { 1197 if (length $$rdata) {
1191 utf8::decode (my $decname = $filename); 1198 utf8::decode (my $decname = $filename);
1192 warn sprintf "saving %s (%d,%d)\n", 1199 warn sprintf "saving %s (%d,%d)\n",
1193 $decname, length $$rdata, scalar @$objs; 1200 $decname, length $$rdata, scalar @$objs
1201 if $VERBOSE_IO;
1194 1202
1195 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1203 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1196 aio_chmod $fh, SAVE_MODE; 1204 aio_chmod $fh, SAVE_MODE;
1197 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1205 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1198 if ($cf::USE_FSYNC) { 1206 if ($cf::USE_FSYNC) {
… …
1255 $av = $st->{objs}; 1263 $av = $st->{objs};
1256 } 1264 }
1257 1265
1258 utf8::decode (my $decname = $filename); 1266 utf8::decode (my $decname = $filename);
1259 warn sprintf "loading %s (%d,%d)\n", 1267 warn sprintf "loading %s (%d,%d)\n",
1260 $decname, length $data, scalar @{$av || []}; 1268 $decname, length $data, scalar @{$av || []}
1269 if $VERBOSE_IO;
1261 1270
1262 ($data, $av) 1271 ($data, $av)
1263} 1272}
1264 1273
1265=head2 COMMAND CALLBACKS 1274=head2 COMMAND CALLBACKS
… …
1436 if (length $@) { 1445 if (length $@) {
1437 warn "$v->{path}: $@\n"; 1446 warn "$v->{path}: $@\n";
1438 1447
1439 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1448 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1440 if exists $v->{meta}{mandatory}; 1449 if exists $v->{meta}{mandatory};
1450
1451 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
1452 delete $todo{$k};
1441 } else { 1453 } else {
1442 $done{$k} = delete $todo{$k}; 1454 $done{$k} = delete $todo{$k};
1443 push @EXTS, $v->{pkg}; 1455 push @EXTS, $v->{pkg};
1444 $progress = 1; 1456 $progress = 1;
1445 1457
… …
1688 \@logins 1700 \@logins
1689} 1701}
1690 1702
1691=item $player->maps 1703=item $player->maps
1692 1704
1705=item cf::player::maps $login
1706
1693Returns an arrayref of map paths that are private for this 1707Returns an arrayref of map paths that are private for this
1694player. May block. 1708player. May block.
1695 1709
1696=cut 1710=cut
1697 1711
… …
1758 1772
1759=cut 1773=cut
1760 1774
1761sub find_by_path($) { 1775sub find_by_path($) {
1762 my ($path) = @_; 1776 my ($path) = @_;
1777
1778 $path =~ s/^~[^\/]*//; # skip ~login
1763 1779
1764 my ($match, $specificity); 1780 my ($match, $specificity);
1765 1781
1766 for my $region (list) { 1782 for my $region (list) {
1767 if ($region->{match} && $path =~ $region->{match}) { 1783 if ($region->{match} && $path =~ $region->{match}) {
… …
1831 1847
1832 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1848 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1833} 1849}
1834 1850
1835# also paths starting with '/' 1851# also paths starting with '/'
1836$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1852$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1837 1853
1838sub thawer_merge { 1854sub thawer_merge {
1839 my ($self, $merge) = @_; 1855 my ($self, $merge) = @_;
1840 1856
1841 # we have to keep some variables in memory intact 1857 # we have to keep some variables in memory intact
… …
2151 or next; 2167 or next;
2152 $neigh = find $neigh, $map 2168 $neigh = find $neigh, $map
2153 or next; 2169 or next;
2154 $neigh->load; 2170 $neigh->load;
2155 2171
2172 # now find the diagonal neighbours
2156 push @neigh, 2173 push @neigh,
2157 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2174 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2158 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2175 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2159 } 2176 }
2160 2177
… …
2212 $MAP_PREFETCHER->prio (6); 2229 $MAP_PREFETCHER->prio (6);
2213 2230
2214 () 2231 ()
2215} 2232}
2216 2233
2234# common code, used by both ->save and ->swapout
2217sub save { 2235sub _save {
2218 my ($self) = @_; 2236 my ($self) = @_;
2219
2220 my $lock = cf::lock_acquire "map_data:$self->{path}";
2221 2237
2222 $self->{last_save} = $cf::RUNTIME; 2238 $self->{last_save} = $cf::RUNTIME;
2223 2239
2224 return unless $self->dirty; 2240 return unless $self->dirty;
2225 2241
… …
2245 } else { 2261 } else {
2246 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 2262 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
2247 } 2263 }
2248} 2264}
2249 2265
2266sub save {
2267 my ($self) = @_;
2268
2269 my $lock = cf::lock_acquire "map_data:$self->{path}";
2270
2271 $self->_save;
2272}
2273
2250sub swap_out { 2274sub swap_out {
2251 my ($self) = @_; 2275 my ($self) = @_;
2252 2276
2253 # save first because save cedes
2254 $self->save;
2255
2256 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2277 my $lock = cf::lock_acquire "map_data:$self->{path}";
2257 2278
2258 return if $self->players;
2259 return if $self->in_memory != cf::MAP_ACTIVE; 2279 return if $self->in_memory != cf::MAP_ACTIVE;
2260 return if $self->{deny_save}; 2280 return if $self->{deny_save};
2281 return if $self->players;
2261 2282
2283 # first deactivate the map and "unlink" it from the core
2284 $self->deactivate;
2285 $_->clear_links_to ($self) for values %cf::MAP;
2262 $self->in_memory (cf::MAP_SWAPPED); 2286 $self->in_memory (cf::MAP_SWAPPED);
2287
2288 # then atomically save
2289 $self->_save;
2290
2291 # then free the map
2292 $self->clear;
2293}
2294
2295sub reset_at {
2296 my ($self) = @_;
2297
2298 # TODO: safety, remove and allow resettable per-player maps
2299 return 1e99 if $self->{deny_reset};
2300
2301 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2302 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2303
2304 $time + $to
2305}
2306
2307sub should_reset {
2308 my ($self) = @_;
2309
2310 $self->reset_at <= $cf::RUNTIME
2311}
2312
2313sub reset {
2314 my ($self) = @_;
2315
2316 my $lock = cf::lock_acquire "map_data:$self->{path}";
2317
2318 return if $self->players;
2319
2320 warn "resetting map ", $self->path, "\n";
2321
2322 $self->in_memory (cf::MAP_SWAPPED);
2323
2324 # need to save uniques path
2325 unless ($self->{deny_save}) {
2326 my $uniq = $self->uniq_path; utf8::encode $uniq;
2327
2328 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2329 if $uniq;
2330 }
2331
2332 delete $cf::MAP{$self->path};
2263 2333
2264 $self->deactivate; 2334 $self->deactivate;
2265 $_->clear_links_to ($self) for values %cf::MAP; 2335 $_->clear_links_to ($self) for values %cf::MAP;
2266 $self->clear; 2336 $self->clear;
2267}
2268
2269sub reset_at {
2270 my ($self) = @_;
2271
2272 # TODO: safety, remove and allow resettable per-player maps
2273 return 1e99 if $self->{deny_reset};
2274
2275 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2276 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2277
2278 $time + $to
2279}
2280
2281sub should_reset {
2282 my ($self) = @_;
2283
2284 $self->reset_at <= $cf::RUNTIME
2285}
2286
2287sub reset {
2288 my ($self) = @_;
2289
2290 my $lock = cf::lock_acquire "map_data:$self->{path}";
2291
2292 return if $self->players;
2293
2294 warn "resetting map ", $self->path, "\n";
2295
2296 $self->in_memory (cf::MAP_SWAPPED);
2297
2298 # need to save uniques path
2299 unless ($self->{deny_save}) {
2300 my $uniq = $self->uniq_path; utf8::encode $uniq;
2301
2302 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2303 if $uniq;
2304 }
2305
2306 delete $cf::MAP{$self->path};
2307
2308 $self->deactivate;
2309 $_->clear_links_to ($self) for values %cf::MAP;
2310 $self->clear;
2311 2337
2312 $self->unlink_save; 2338 $self->unlink_save;
2313 $self->destroy; 2339 $self->destroy;
2314} 2340}
2315 2341
… …
2323 2349
2324 delete $cf::MAP{$self->path}; 2350 delete $cf::MAP{$self->path};
2325 2351
2326 $self->unlink_save; 2352 $self->unlink_save;
2327 2353
2328 bless $self, "cf::map"; 2354 bless $self, "cf::map::wrap";
2329 delete $self->{deny_reset}; 2355 delete $self->{deny_reset};
2330 $self->{deny_save} = 1; 2356 $self->{deny_save} = 1;
2331 $self->reset_timeout (1); 2357 $self->reset_timeout (1);
2332 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2358 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2333 2359
… …
2563 2589
2564Freezes the player and moves him/her to a special map (C<{link}>). 2590Freezes the player and moves him/her to a special map (C<{link}>).
2565 2591
2566The player should be reasonably safe there for short amounts of time (e.g. 2592The player should be reasonably safe there for short amounts of time (e.g.
2567for loading a map). You I<MUST> call C<leave_link> as soon as possible, 2593for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2568though, as the palyer cannot control the character while it is on the link 2594though, as the player cannot control the character while it is on the link
2569map. 2595map.
2570 2596
2571Will never block. 2597Will never block.
2572 2598
2573=item $player_object->leave_link ($map, $x, $y) 2599=item $player_object->leave_link ($map, $x, $y)
… …
2594sub cf::object::player::enter_link { 2620sub cf::object::player::enter_link {
2595 my ($self) = @_; 2621 my ($self) = @_;
2596 2622
2597 $self->deactivate_recursive; 2623 $self->deactivate_recursive;
2598 2624
2625 ++$self->{_link_recursion};
2626
2599 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2627 return if UNIVERSAL::isa $self->map, "ext::map_link";
2600 2628
2601 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2629 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2602 if $self->map && $self->map->{path} ne "{link}"; 2630 if $self->map && $self->map->{path} ne "{link}";
2603 2631
2604 $self->enter_map ($LINK_MAP || link_map, 10, 10); 2632 $self->enter_map ($LINK_MAP || link_map, 3, 3);
2605} 2633}
2606 2634
2607sub cf::object::player::leave_link { 2635sub cf::object::player::leave_link {
2608 my ($self, $map, $x, $y) = @_; 2636 my ($self, $map, $x, $y) = @_;
2609 2637
… …
2634 $map->load_neighbours; 2662 $map->load_neighbours;
2635 2663
2636 return unless $self->contr->active; 2664 return unless $self->contr->active;
2637 2665
2638 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2666 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2639 $self->enter_map ($map, $x, $y); 2667 if ($self->enter_map ($map, $x, $y)) {
2640 2668 # entering was successful
2669 delete $self->{_link_recursion};
2641 # only activate afterwards, to support waiting in hooks 2670 # only activate afterwards, to support waiting in hooks
2642 $self->activate_recursive; 2671 $self->activate_recursive;
2643} 2672 }
2644 2673
2674}
2675
2645=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2676=item $player_object->goto ($path, $x, $y[, $check->($map, $x, $y, $player)[, $done->($player)]])
2646 2677
2647Moves the player to the given map-path and coordinates by first freezing 2678Moves the player to the given map-path and coordinates by first freezing
2648her, loading and preparing them map, calling the provided $check callback 2679her, loading and preparing them map, calling the provided $check callback
2649that has to return the map if sucecssful, and then unfreezes the player on 2680that has to return the map if sucecssful, and then unfreezes the player on
2650the new (success) or old (failed) map position. In either case, $done will 2681the new (success) or old (failed) map position. In either case, $done will
… …
2657 2688
2658our $GOTOGEN; 2689our $GOTOGEN;
2659 2690
2660sub cf::object::player::goto { 2691sub cf::object::player::goto {
2661 my ($self, $path, $x, $y, $check, $done) = @_; 2692 my ($self, $path, $x, $y, $check, $done) = @_;
2693
2694 if ($self->{_link_recursion} >= $MAX_LINKS) {
2695 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2696 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2697 ($path, $x, $y) = @$EMERGENCY_POSITION;
2698 }
2662 2699
2663 # do generation counting so two concurrent goto's will be executed in-order 2700 # do generation counting so two concurrent goto's will be executed in-order
2664 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2701 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2665 2702
2666 $self->enter_link; 2703 $self->enter_link;
… …
2690 my $map = eval { 2727 my $map = eval {
2691 my $map = defined $path ? cf::map::find $path : undef; 2728 my $map = defined $path ? cf::map::find $path : undef;
2692 2729
2693 if ($map) { 2730 if ($map) {
2694 $map = $map->customise_for ($self); 2731 $map = $map->customise_for ($self);
2695 $map = $check->($map) if $check && $map; 2732 $map = $check->($map, $x, $y, $self) if $check && $map;
2696 } else { 2733 } else {
2697 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED); 2734 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
2698 } 2735 }
2699 2736
2700 $map 2737 $map
… …
2708 if ($gen == $self->{_goto_generation}) { 2745 if ($gen == $self->{_goto_generation}) {
2709 delete $self->{_goto_generation}; 2746 delete $self->{_goto_generation};
2710 $self->leave_link ($map, $x, $y); 2747 $self->leave_link ($map, $x, $y);
2711 } 2748 }
2712 2749
2713 $done->() if $done; 2750 $done->($self) if $done;
2714 })->prio (1); 2751 })->prio (1);
2715} 2752}
2716 2753
2717=item $player_object->enter_exit ($exit_object) 2754=item $player_object->enter_exit ($exit_object)
2718 2755
… …
3491 or return; 3528 or return;
3492 3529
3493 local $/; 3530 local $/;
3494 *CFG = YAML::XS::Load scalar <$fh>; 3531 *CFG = YAML::XS::Load scalar <$fh>;
3495 3532
3496 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3533 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3497 3534
3498 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3535 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3499 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3536 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3500 3537
3501 if (exists $CFG{mlockall}) { 3538 if (exists $CFG{mlockall}) {
… …
3542 3579
3543 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3580 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3544 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3581 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3545 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3582 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3546 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3583 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3547
3548 cf::init_experience;
3549 cf::init_anim;
3550 cf::init_attackmess;
3551 cf::init_dynamic;
3552 3584
3553 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3585 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3554 3586
3555 # we must not ever block the main coroutine 3587 # we must not ever block the main coroutine
3556 local $Coro::idle = sub { 3588 local $Coro::idle = sub {
… …
3562 }; 3594 };
3563 3595
3564 evthread_start IO::AIO::poll_fileno; 3596 evthread_start IO::AIO::poll_fileno;
3565 3597
3566 cf::sync_job { 3598 cf::sync_job {
3599 cf::init_experience;
3600 cf::init_anim;
3601 cf::init_attackmess;
3602 cf::init_dynamic;
3603
3567 cf::load_settings; 3604 cf::load_settings;
3568 cf::load_materials; 3605 cf::load_materials;
3569 3606
3570 reload_resources; 3607 reload_resources;
3571 reload_config; 3608 reload_config;
… …
3587 use POSIX (); 3624 use POSIX ();
3588 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3625 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3589 3626
3590 (pop @POST_INIT)->(0) while @POST_INIT; 3627 (pop @POST_INIT)->(0) while @POST_INIT;
3591 }; 3628 };
3629
3630 cf::object::thawer::errors_are_fatal 0;
3631 warn "parse errors in files are no longer fatal from this point on.\n";
3592 3632
3593 main_loop; 3633 main_loop;
3594} 3634}
3595 3635
3596############################################################################# 3636#############################################################################
… …
3773 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3813 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3774 for my $name (keys %$leaf_symtab) { 3814 for my $name (keys %$leaf_symtab) {
3775 _gv_clear *{"$pkg$name"}; 3815 _gv_clear *{"$pkg$name"};
3776# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3816# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3777 } 3817 }
3778 warn "cleared package $pkg\n";#d#
3779} 3818}
3780 3819
3781sub do_reload_perl() { 3820sub do_reload_perl() {
3782 # can/must only be called in main 3821 # can/must only be called in main
3783 if ($Coro::current != $Coro::main) { 3822 if (in_main) {
3784 warn "can only reload from main coroutine"; 3823 warn "can only reload from main coroutine";
3785 return; 3824 return;
3786 } 3825 }
3787 3826
3788 return if $RELOAD++; 3827 return if $RELOAD++;

Diff Legend

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