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.516 by root, Thu Apr 15 06:05:52 2010 UTC vs.
Revision 1.529 by root, Wed Apr 28 11:28:22 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 = 1;
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
… …
1623 $pl->password ("*"); # this should lock out the player until we have nuked the dir 1635 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1624 1636
1625 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1626 $pl->deactivate; 1638 $pl->deactivate;
1627 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1639 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1628 $pl->ob->check_score;
1629 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1640 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1630 $pl->ns->destroy if $pl->ns; 1641 $pl->ns->destroy if $pl->ns;
1631 1642
1632 my $path = playerdir $pl; 1643 my $path = playerdir $pl;
1633 my $temp = "$path~$cf::RUNTIME~deleting~"; 1644 my $temp = "$path~$cf::RUNTIME~deleting~";
… …
1688 \@logins 1699 \@logins
1689} 1700}
1690 1701
1691=item $player->maps 1702=item $player->maps
1692 1703
1704=item cf::player::maps $login
1705
1693Returns an arrayref of map paths that are private for this 1706Returns an arrayref of map paths that are private for this
1694player. May block. 1707player. May block.
1695 1708
1696=cut 1709=cut
1697 1710
… …
1758 1771
1759=cut 1772=cut
1760 1773
1761sub find_by_path($) { 1774sub find_by_path($) {
1762 my ($path) = @_; 1775 my ($path) = @_;
1776
1777 $path =~ s/^~[^\/]*//; # skip ~login
1763 1778
1764 my ($match, $specificity); 1779 my ($match, $specificity);
1765 1780
1766 for my $region (list) { 1781 for my $region (list) {
1767 if ($region->{match} && $path =~ $region->{match}) { 1782 if ($region->{match} && $path =~ $region->{match}) {
… …
1831 1846
1832 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1833} 1848}
1834 1849
1835# also paths starting with '/' 1850# also paths starting with '/'
1836$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1851$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1837 1852
1838sub thawer_merge { 1853sub thawer_merge {
1839 my ($self, $merge) = @_; 1854 my ($self, $merge) = @_;
1840 1855
1841 # we have to keep some variables in memory intact 1856 # we have to keep some variables in memory intact
… …
2151 or next; 2166 or next;
2152 $neigh = find $neigh, $map 2167 $neigh = find $neigh, $map
2153 or next; 2168 or next;
2154 $neigh->load; 2169 $neigh->load;
2155 2170
2171 # now find the diagonal neighbours
2156 push @neigh, 2172 push @neigh,
2157 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2158 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2159 } 2175 }
2160 2176
… …
2212 $MAP_PREFETCHER->prio (6); 2228 $MAP_PREFETCHER->prio (6);
2213 2229
2214 () 2230 ()
2215} 2231}
2216 2232
2233# common code, used by both ->save and ->swapout
2217sub save { 2234sub _save {
2218 my ($self) = @_; 2235 my ($self) = @_;
2219
2220 my $lock = cf::lock_acquire "map_data:$self->{path}";
2221 2236
2222 $self->{last_save} = $cf::RUNTIME; 2237 $self->{last_save} = $cf::RUNTIME;
2223 2238
2224 return unless $self->dirty; 2239 return unless $self->dirty;
2225 2240
… …
2245 } else { 2260 } else {
2246 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 2261 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
2247 } 2262 }
2248} 2263}
2249 2264
2265sub save {
2266 my ($self) = @_;
2267
2268 my $lock = cf::lock_acquire "map_data:$self->{path}";
2269
2270 $self->_save;
2271}
2272
2250sub swap_out { 2273sub swap_out {
2251 my ($self) = @_; 2274 my ($self) = @_;
2252 2275
2253 # save first because save cedes
2254 $self->save;
2255
2256 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2276 my $lock = cf::lock_acquire "map_data:$self->{path}";
2257 2277
2258 return if $self->players;
2259 return if $self->in_memory != cf::MAP_ACTIVE; 2278 return if $self->in_memory != cf::MAP_ACTIVE;
2260 return if $self->{deny_save}; 2279 return if $self->{deny_save};
2280 return if $self->players;
2261 2281
2282 # first deactivate the map and "unlink" it from the core
2283 $self->deactivate;
2284 $_->clear_links_to ($self) for values %cf::MAP;
2262 $self->in_memory (cf::MAP_SWAPPED); 2285 $self->in_memory (cf::MAP_SWAPPED);
2286
2287 # then atomically save
2288 $self->_save;
2289
2290 # then free the map
2291 $self->clear;
2292}
2293
2294sub reset_at {
2295 my ($self) = @_;
2296
2297 # TODO: safety, remove and allow resettable per-player maps
2298 return 1e99 if $self->{deny_reset};
2299
2300 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2301 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2302
2303 $time + $to
2304}
2305
2306sub should_reset {
2307 my ($self) = @_;
2308
2309 $self->reset_at <= $cf::RUNTIME
2310}
2311
2312sub reset {
2313 my ($self) = @_;
2314
2315 my $lock = cf::lock_acquire "map_data:$self->{path}";
2316
2317 return if $self->players;
2318
2319 warn "resetting map ", $self->path, "\n";
2320
2321 $self->in_memory (cf::MAP_SWAPPED);
2322
2323 # need to save uniques path
2324 unless ($self->{deny_save}) {
2325 my $uniq = $self->uniq_path; utf8::encode $uniq;
2326
2327 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2328 if $uniq;
2329 }
2330
2331 delete $cf::MAP{$self->path};
2263 2332
2264 $self->deactivate; 2333 $self->deactivate;
2265 $_->clear_links_to ($self) for values %cf::MAP; 2334 $_->clear_links_to ($self) for values %cf::MAP;
2266 $self->clear; 2335 $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 2336
2312 $self->unlink_save; 2337 $self->unlink_save;
2313 $self->destroy; 2338 $self->destroy;
2314} 2339}
2315 2340
… …
2323 2348
2324 delete $cf::MAP{$self->path}; 2349 delete $cf::MAP{$self->path};
2325 2350
2326 $self->unlink_save; 2351 $self->unlink_save;
2327 2352
2328 bless $self, "cf::map"; 2353 bless $self, "cf::map::wrap";
2329 delete $self->{deny_reset}; 2354 delete $self->{deny_reset};
2330 $self->{deny_save} = 1; 2355 $self->{deny_save} = 1;
2331 $self->reset_timeout (1); 2356 $self->reset_timeout (1);
2332 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2357 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2333 2358
… …
2563 2588
2564Freezes the player and moves him/her to a special map (C<{link}>). 2589Freezes the player and moves him/her to a special map (C<{link}>).
2565 2590
2566The player should be reasonably safe there for short amounts of time (e.g. 2591The 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, 2592for 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 2593though, as the player cannot control the character while it is on the link
2569map. 2594map.
2570 2595
2571Will never block. 2596Will never block.
2572 2597
2573=item $player_object->leave_link ($map, $x, $y) 2598=item $player_object->leave_link ($map, $x, $y)
… …
2594sub cf::object::player::enter_link { 2619sub cf::object::player::enter_link {
2595 my ($self) = @_; 2620 my ($self) = @_;
2596 2621
2597 $self->deactivate_recursive; 2622 $self->deactivate_recursive;
2598 2623
2624 ++$self->{_link_recursion};
2625
2599 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2626 return if UNIVERSAL::isa $self->map, "ext::map_link";
2600 2627
2601 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2628 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2602 if $self->map && $self->map->{path} ne "{link}"; 2629 if $self->map && $self->map->{path} ne "{link}";
2603 2630
2604 $self->enter_map ($LINK_MAP || link_map, 10, 10); 2631 $self->enter_map ($LINK_MAP || link_map, 3, 3);
2605} 2632}
2606 2633
2607sub cf::object::player::leave_link { 2634sub cf::object::player::leave_link {
2608 my ($self, $map, $x, $y) = @_; 2635 my ($self, $map, $x, $y) = @_;
2609 2636
… …
2634 $map->load_neighbours; 2661 $map->load_neighbours;
2635 2662
2636 return unless $self->contr->active; 2663 return unless $self->contr->active;
2637 2664
2638 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2639 $self->enter_map ($map, $x, $y); 2666 if ($self->enter_map ($map, $x, $y)) {
2640 2667 # entering was successful
2668 delete $self->{_link_recursion};
2641 # only activate afterwards, to support waiting in hooks 2669 # only activate afterwards, to support waiting in hooks
2642 $self->activate_recursive; 2670 $self->activate_recursive;
2643} 2671 }
2644 2672
2673}
2674
2645=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2675=item $player_object->goto ($path, $x, $y[, $check->($map, $x, $y, $player)[, $done->($player)]])
2646 2676
2647Moves the player to the given map-path and coordinates by first freezing 2677Moves the player to the given map-path and coordinates by first freezing
2648her, loading and preparing them map, calling the provided $check callback 2678her, loading and preparing them map, calling the provided $check callback
2649that has to return the map if sucecssful, and then unfreezes the player on 2679that 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 2680the new (success) or old (failed) map position. In either case, $done will
… …
2657 2687
2658our $GOTOGEN; 2688our $GOTOGEN;
2659 2689
2660sub cf::object::player::goto { 2690sub cf::object::player::goto {
2661 my ($self, $path, $x, $y, $check, $done) = @_; 2691 my ($self, $path, $x, $y, $check, $done) = @_;
2692
2693 if ($self->{_link_recursion} >= $MAX_LINKS) {
2694 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2695 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2696 ($path, $x, $y) = @$EMERGENCY_POSITION;
2697 }
2662 2698
2663 # do generation counting so two concurrent goto's will be executed in-order 2699 # do generation counting so two concurrent goto's will be executed in-order
2664 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2700 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2665 2701
2666 $self->enter_link; 2702 $self->enter_link;
… …
2690 my $map = eval { 2726 my $map = eval {
2691 my $map = defined $path ? cf::map::find $path : undef; 2727 my $map = defined $path ? cf::map::find $path : undef;
2692 2728
2693 if ($map) { 2729 if ($map) {
2694 $map = $map->customise_for ($self); 2730 $map = $map->customise_for ($self);
2695 $map = $check->($map) if $check && $map; 2731 $map = $check->($map, $x, $y, $self) if $check && $map;
2696 } else { 2732 } else {
2697 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED); 2733 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
2698 } 2734 }
2699 2735
2700 $map 2736 $map
… …
2708 if ($gen == $self->{_goto_generation}) { 2744 if ($gen == $self->{_goto_generation}) {
2709 delete $self->{_goto_generation}; 2745 delete $self->{_goto_generation};
2710 $self->leave_link ($map, $x, $y); 2746 $self->leave_link ($map, $x, $y);
2711 } 2747 }
2712 2748
2713 $done->() if $done; 2749 $done->($self) if $done;
2714 })->prio (1); 2750 })->prio (1);
2715} 2751}
2716 2752
2717=item $player_object->enter_exit ($exit_object) 2753=item $player_object->enter_exit ($exit_object)
2718 2754
… …
3491 or return; 3527 or return;
3492 3528
3493 local $/; 3529 local $/;
3494 *CFG = YAML::XS::Load scalar <$fh>; 3530 *CFG = YAML::XS::Load scalar <$fh>;
3495 3531
3496 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3532 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3497 3533
3498 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3534 $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}; 3535 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3500 3536
3501 if (exists $CFG{mlockall}) { 3537 if (exists $CFG{mlockall}) {
… …
3589 3625
3590 (pop @POST_INIT)->(0) while @POST_INIT; 3626 (pop @POST_INIT)->(0) while @POST_INIT;
3591 }; 3627 };
3592 3628
3593 cf::object::thawer::errors_are_fatal 0; 3629 cf::object::thawer::errors_are_fatal 0;
3630 warn "parse errors in files are no longer fatal from this point on.\n";
3594 3631
3595 main_loop; 3632 main_loop;
3596} 3633}
3597 3634
3598############################################################################# 3635#############################################################################
… …
3775 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3812 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3776 for my $name (keys %$leaf_symtab) { 3813 for my $name (keys %$leaf_symtab) {
3777 _gv_clear *{"$pkg$name"}; 3814 _gv_clear *{"$pkg$name"};
3778# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3815# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3779 } 3816 }
3780 warn "cleared package $pkg\n";#d#
3781} 3817}
3782 3818
3783sub do_reload_perl() { 3819sub do_reload_perl() {
3784 # can/must only be called in main 3820 # can/must only be called in main
3785 if ($Coro::current != $Coro::main) { 3821 if (in_main) {
3786 warn "can only reload from main coroutine"; 3822 warn "can only reload from main coroutine";
3787 return; 3823 return;
3788 } 3824 }
3789 3825
3790 return if $RELOAD++; 3826 return if $RELOAD++;

Diff Legend

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