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.132 by root, Thu Jan 4 01:35:56 2007 UTC vs.
Revision 1.140 by root, Fri Jan 5 20:04:02 2007 UTC

… …
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 26use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 27
28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29$YAML::Syck::ImplicitUnicode = 1; 29$YAML::Syck::ImplicitUnicode = 1;
30 30
31$Coro::main->prio (2); # run main coroutine ("the server") with very high priority 31$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32 32
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34 34
35our %COMMAND = (); 35our %COMMAND = ();
36our %COMMAND_TIME = (); 36our %COMMAND_TIME = ();
… …
49our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 50our $RUNTIME;
51 51
52our %MAP; # all maps 52our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 53our $LINK_MAP; # the special {link} map
54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random"; 54our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO; 55our %EXT_CORO;
57 56
58binmode STDOUT; 57binmode STDOUT;
59binmode STDERR; 58binmode STDERR;
… …
180sub to_json($) { 179sub to_json($) {
181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
182 JSON::Syck::Dump $_[0] 181 JSON::Syck::Dump $_[0]
183} 182}
184 183
185=item my $guard = cf::guard { BLOCK }
186
187Run the given callback when the guard object gets destroyed (useful for
188coroutine cancellations).
189
190You can call C<< ->cancel >> on the guard object to stop the block from
191being executed.
192
193=cut
194
195sub guard(&) {
196 bless \(my $cb = $_[0]), cf::guard::;
197}
198
199sub cf::guard::cancel {
200 ${$_[0]} = sub { };
201}
202
203sub cf::guard::DESTROY {
204 ${$_[0]}->();
205}
206
207=item cf::lock_wait $string 184=item cf::lock_wait $string
208 185
209Wait until the given lock is available. See cf::lock_acquire. 186Wait until the given lock is available. See cf::lock_acquire.
210 187
211=item my $lock = cf::lock_acquire $string 188=item my $lock = cf::lock_acquire $string
212 189
213Wait until the given lock is available and then acquires it and returns 190Wait until the given lock is available and then acquires it and returns
214a guard object. If the guard object gets destroyed (goes out of scope, 191a Coro::guard object. If the guard object gets destroyed (goes out of scope,
215for example when the coroutine gets canceled), the lock is automatically 192for example when the coroutine gets canceled), the lock is automatically
216returned. 193returned.
217 194
218Lock names should begin with a unique identifier (for example, find_map 195Lock names should begin with a unique identifier (for example, cf::map::find
219uses map_find and load_map uses map_load). 196uses map_find and cf::map::load uses map_load).
220 197
221=cut 198=cut
222 199
223our %LOCK; 200our %LOCK;
224 201
… …
238 # wait, to be sure we are not locked 215 # wait, to be sure we are not locked
239 lock_wait $key; 216 lock_wait $key;
240 217
241 $LOCK{$key} = []; 218 $LOCK{$key} = [];
242 219
243 cf::guard { 220 Coro::guard {
244 # wake up all waiters, to be on the safe side 221 # wake up all waiters, to be on the safe side
245 $_->ready for @{ delete $LOCK{$key} }; 222 $_->ready for @{ delete $LOCK{$key} };
246 } 223 }
247} 224}
248 225
226sub freeze_mainloop {
227 return unless $TICK_WATCHER->is_active;
228
229 my $guard = Coro::guard { $TICK_WATCHER->start };
230 $TICK_WATCHER->stop;
231 $guard
232}
233
249=item cf::async { BLOCK } 234=item cf::async { BLOCK }
250 235
251Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the 236Currently the same as Coro::async_pool, meaning you cannot use
252error instead of exiting the server in case of a problem. 237C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
238thing you are allowed to do is call C<prio> on it.
253 239
254=cut 240=cut
255 241
256sub async(&) { 242BEGIN { *async = \&Coro::async_pool }
257 my ($cb) = @_;
258
259 Coro::async {
260 eval { $cb->() };
261 warn $@ if $@;
262 }
263}
264 243
265=item cf::sync_job { BLOCK } 244=item cf::sync_job { BLOCK }
266 245
267The design of crossfire+ requires that the main coro ($Coro::main) is 246The design of crossfire+ requires that the main coro ($Coro::main) is
268always able to handle events or runnable, as crossfire+ is only partly 247always able to handle events or runnable, as crossfire+ is only partly
… …
282 # this is the main coro, too bad, we have to block 261 # this is the main coro, too bad, we have to block
283 # till the operation succeeds, freezing the server :/ 262 # till the operation succeeds, freezing the server :/
284 263
285 # TODO: use suspend/resume instead 264 # TODO: use suspend/resume instead
286 # (but this is cancel-safe) 265 # (but this is cancel-safe)
287 local $FREEZE = 1; 266 my $freeze_guard = freeze_mainloop;
288 267
289 my $busy = 1; 268 my $busy = 1;
290 my @res; 269 my @res;
291 270
292 (Coro::async { 271 (async {
293 @res = eval { $job->() }; 272 @res = eval { $job->() };
294 warn $@ if $@; 273 warn $@ if $@;
295 undef $busy; 274 undef $busy;
296 })->prio (Coro::PRIO_MAX); 275 })->prio (Coro::PRIO_MAX);
297 276
298 while ($busy) { 277 while ($busy) {
299 Coro::cede_notself; 278 unless (Coro::cede) {
300 Event::one_event unless Coro::nready; 279 Coro::nready ? Event::one_event 0 : Event::one_event;
280 Coro::cede_notself unless Coro::cede;
281 }
301 } 282 }
302 283
303 wantarray ? @res : $res[0] 284 wantarray ? @res : $res[0]
304 } else { 285 } else {
305 # we are in another coroutine, how wonderful, everything just works 286 # we are in another coroutine, how wonderful, everything just works
306 287
307 $job->() 288 $job->()
308 } 289 }
309} 290}
310 291
311=item $coro = cf::coro { BLOCK } 292=item $coro = cf::async_ext { BLOCK }
312 293
313Creates and returns a new coro. This coro is automcatially being canceled 294Like async, but this coro is automcatially being canceled when the
314when the extension calling this is being unloaded. 295extension calling this is being unloaded.
315 296
316=cut 297=cut
317 298
318sub coro(&) { 299sub async_ext(&) {
319 my $cb = shift; 300 my $cb = shift;
320 301
321 my $coro = &cf::async ($cb); 302 my $coro = &Coro::async ($cb);
322 303
323 $coro->on_destroy (sub { 304 $coro->on_destroy (sub {
324 delete $EXT_CORO{$coro+0}; 305 delete $EXT_CORO{$coro+0};
325 }); 306 });
326 $EXT_CORO{$coro+0} = $coro; 307 $EXT_CORO{$coro+0} = $coro;
… …
1136package cf::map; 1117package cf::map;
1137 1118
1138use Fcntl; 1119use Fcntl;
1139use Coro::AIO; 1120use Coro::AIO;
1140 1121
1141our $MAX_RESET = 7200; 1122our $MAX_RESET = 3600;
1142our $DEFAULT_RESET = 3600; 1123our $DEFAULT_RESET = 3000;
1143 1124
1144sub generate_random_map { 1125sub generate_random_map {
1145 my ($path, $rmp) = @_; 1126 my ($path, $rmp) = @_;
1146 1127
1147 # mit "rum" bekleckern, nicht 1128 # mit "rum" bekleckern, nicht
… …
1177 or return; 1158 or return;
1178 1159
1179 my $map = cf::map::new 1160 my $map = cf::map::new
1180 or return; 1161 or return;
1181 1162
1163 # for better error messages only, will be overwritten
1164 $map->path ($path);
1165
1182 $map->load_header ($path) 1166 $map->load_header ($path)
1183 or return; 1167 or return;
1184 1168
1185 $map->{load_path} = $path; 1169 $map->{load_path} = $path;
1186 1170
1187 $map 1171 $map
1188} 1172}
1189 1173
1190sub find_map; 1174sub find;
1191sub find_map { 1175sub find {
1192 my ($path, $origin) = @_; 1176 my ($path, $origin) = @_;
1193 1177
1194 #warn "find_map<$path,$origin>\n";#d# 1178 #warn "find<$path,$origin>\n";#d#
1195 1179
1196 $path = new cf::path $path, $origin && $origin->path; 1180 $path = new cf::path $path, $origin && $origin->path;
1197 my $key = $path->as_string; 1181 my $key = $path->as_string;
1198 1182
1199 cf::lock_wait "map_find:$key"; 1183 cf::lock_wait "map_find:$key";
… …
1201 $cf::MAP{$key} || do { 1185 $cf::MAP{$key} || do {
1202 my $guard = cf::lock_acquire "map_find:$key"; 1186 my $guard = cf::lock_acquire "map_find:$key";
1203 1187
1204 # do it the slow way 1188 # do it the slow way
1205 my $map = try_load_header $path->save_path; 1189 my $map = try_load_header $path->save_path;
1190
1191 Coro::cede;
1206 1192
1207 if ($map) { 1193 if ($map) {
1208 $map->last_access ((delete $map->{last_access}) 1194 $map->last_access ((delete $map->{last_access})
1209 || $cf::RUNTIME); #d# 1195 || $cf::RUNTIME); #d#
1210 # safety 1196 # safety
… …
1230 1216
1231 $map->path ($key); 1217 $map->path ($key);
1232 $map->{path} = $path; 1218 $map->{path} = $path;
1233 $map->{last_save} = $cf::RUNTIME; 1219 $map->{last_save} = $cf::RUNTIME;
1234 1220
1221 Coro::cede;
1222
1235 if ($map->should_reset) { 1223 if ($map->should_reset) {
1236 $map->reset; 1224 $map->reset;
1237 undef $guard; 1225 undef $guard;
1238 $map = find_map $path 1226 $map = find $path
1239 or return; 1227 or return;
1240 } 1228 }
1241 1229
1242 $cf::MAP{$key} = $map 1230 $cf::MAP{$key} = $map
1243 } 1231 }
… …
1265 if (aio_open $uniq, O_RDONLY, 0) { 1253 if (aio_open $uniq, O_RDONLY, 0) {
1266 $self->clear_unique_items; 1254 $self->clear_unique_items;
1267 $self->load_objects ($uniq, 0); 1255 $self->load_objects ($uniq, 0);
1268 } 1256 }
1269 } 1257 }
1258
1259 Coro::cede;
1270 1260
1271 # now do the right thing for maps 1261 # now do the right thing for maps
1272 $self->link_multipart_objects; 1262 $self->link_multipart_objects;
1273 1263
1274 if ($self->{path}->is_style_map) { 1264 if ($self->{path}->is_style_map) {
… …
1282 $self->difficulty ($self->estimate_difficulty) 1272 $self->difficulty ($self->estimate_difficulty)
1283 unless $self->difficulty; 1273 unless $self->difficulty;
1284 $self->activate; 1274 $self->activate;
1285 } 1275 }
1286 1276
1277 Coro::cede;
1278
1287 $self->in_memory (cf::MAP_IN_MEMORY); 1279 $self->in_memory (cf::MAP_IN_MEMORY);
1288} 1280}
1289 1281
1290sub load_map_sync { 1282sub find_sync {
1291 my ($path, $origin) = @_; 1283 my ($path, $origin) = @_;
1292 1284
1293 #warn "load_map_sync<$path, $origin>\n";#d# 1285 cf::sync_job { cf::map::find $path, $origin }
1286}
1294 1287
1295 cf::sync_job { 1288sub do_load_sync {
1296 my $map = cf::map::find_map $path, $origin 1289 my ($map) = @_;
1297 or return; 1290
1298 $map->load; 1291 cf::sync_job { $map->load };
1299 $map
1300 }
1301} 1292}
1302 1293
1303sub save { 1294sub save {
1304 my ($self) = @_; 1295 my ($self) = @_;
1296
1297 my $lock = cf::lock_acquire "map_data:" . $self->path;
1305 1298
1306 $self->{last_save} = $cf::RUNTIME; 1299 $self->{last_save} = $cf::RUNTIME;
1307 1300
1308 return unless $self->dirty; 1301 return unless $self->dirty;
1309 1302
… …
1328 my ($self) = @_; 1321 my ($self) = @_;
1329 1322
1330 # save first because save cedes 1323 # save first because save cedes
1331 $self->save; 1324 $self->save;
1332 1325
1326 my $lock = cf::lock_acquire "map_data:" . $self->path;
1327
1333 return if $self->players; 1328 return if $self->players;
1334 return if $self->in_memory != cf::MAP_IN_MEMORY; 1329 return if $self->in_memory != cf::MAP_IN_MEMORY;
1335 return if $self->{deny_save}; 1330 return if $self->{deny_save};
1336 1331
1337 $self->clear; 1332 $self->clear;
… …
1379} 1374}
1380 1375
1381sub reset { 1376sub reset {
1382 my ($self) = @_; 1377 my ($self) = @_;
1383 1378
1379 my $lock = cf::lock_acquire "map_data:" . $self->path;
1380
1384 return if $self->players; 1381 return if $self->players;
1385 return if $self->{path}{user_rel};#d# 1382 return if $self->{path}{user_rel};#d#
1386 1383
1387 warn "resetting map ", $self->path;#d# 1384 warn "resetting map ", $self->path;#d#
1388 1385
… …
1407 1404
1408sub customise_for { 1405sub customise_for {
1409 my ($map, $ob) = @_; 1406 my ($map, $ob) = @_;
1410 1407
1411 if ($map->per_player) { 1408 if ($map->per_player) {
1412 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path}; 1409 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
1413 } 1410 }
1414 1411
1415 $map 1412 $map
1416} 1413}
1417 1414
1418sub emergency_save { 1415sub emergency_save {
1419 local $cf::FREEZE = 1; 1416 my $freeze_guard = cf::freeze_mainloop;
1420 1417
1421 warn "enter emergency map save\n"; 1418 warn "enter emergency map save\n";
1422 1419
1423 cf::sync_job { 1420 cf::sync_job {
1424 warn "begin emergency map save\n"; 1421 warn "begin emergency map save\n";
… …
1514 my $link_pos = delete $self->{_link_pos}; 1511 my $link_pos = delete $self->{_link_pos};
1515 1512
1516 unless ($map) { 1513 unless ($map) {
1517 # restore original map position 1514 # restore original map position
1518 ($map, $x, $y) = @{ $link_pos || [] }; 1515 ($map, $x, $y) = @{ $link_pos || [] };
1519 $map = cf::map::find_map $map; 1516 $map = cf::map::find $map;
1520 1517
1521 unless ($map) { 1518 unless ($map) {
1522 ($map, $x, $y) = @$EMERGENCY_POSITION; 1519 ($map, $x, $y) = @$EMERGENCY_POSITION;
1523 $map = cf::map::find_map $map 1520 $map = cf::map::find $map
1524 or die "FATAL: cannot load emergency map\n"; 1521 or die "FATAL: cannot load emergency map\n";
1525 } 1522 }
1526 } 1523 }
1527 1524
1528 ($x, $y) = (-1, -1) 1525 ($x, $y) = (-1, -1)
… …
1553 my ($pl) = @_; 1550 my ($pl) = @_;
1554 1551
1555 # try to abort aborted map switching on player login :) 1552 # try to abort aborted map switching on player login :)
1556 # should happen only on crashes 1553 # should happen only on crashes
1557 if ($pl->ob->{_link_pos}) { 1554 if ($pl->ob->{_link_pos}) {
1555
1558 $pl->ob->enter_link; 1556 $pl->ob->enter_link;
1559 cf::async { 1557 (async {
1560 # we need this sleep as the login has a concurrent enter_exit running 1558 # we need this sleep as the login has a concurrent enter_exit running
1561 # and this sleep increases chances of the player not ending up in scorn 1559 # and this sleep increases chances of the player not ending up in scorn
1560 $pl->ob->reply (undef,
1561 "There was an internal problem at your last logout, "
1562 . "the server will try to bring you to your intended destination in a second.",
1563 cf::NDI_RED);
1562 Coro::Timer::sleep 1; 1564 Coro::Timer::sleep 1;
1563 $pl->ob->leave_link; 1565 $pl->ob->leave_link;
1564 }; 1566 })->prio (2);
1565 } 1567 }
1566 }, 1568 },
1567); 1569);
1568 1570
1569=item $player_object->goto_map ($path, $x, $y) 1571=item $player_object->goto ($path, $x, $y)
1570 1572
1571=cut 1573=cut
1572 1574
1573sub cf::object::player::goto_map { 1575sub cf::object::player::goto {
1574 my ($self, $path, $x, $y) = @_; 1576 my ($self, $path, $x, $y) = @_;
1575 1577
1576 $self->enter_link; 1578 $self->enter_link;
1577 1579
1578 (cf::async { 1580 (async {
1579 $path = new cf::path $path; 1581 $path = new cf::path $path;
1580 1582
1581 my $map = cf::map::find_map $path->as_string; 1583 my $map = cf::map::find $path->as_string;
1582 $map = $map->customise_for ($self) if $map; 1584 $map = $map->customise_for ($self) if $map;
1583 1585
1584# warn "entering ", $map->path, " at ($x, $y)\n" 1586# warn "entering ", $map->path, " at ($x, $y)\n"
1585# if $map; 1587# if $map;
1586 1588
… …
1645 1647
1646 return unless $self->type == cf::PLAYER; 1648 return unless $self->type == cf::PLAYER;
1647 1649
1648 $self->enter_link; 1650 $self->enter_link;
1649 1651
1650 (cf::async { 1652 (async {
1653 $self->deactivate_recursive; # just to be sure
1651 unless (eval { 1654 unless (eval {
1652 prepare_random_map $exit 1655 prepare_random_map $exit
1653 if $exit->slaying eq "/!"; 1656 if $exit->slaying eq "/!";
1654 1657
1655 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1658 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1656 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1659 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1657 1660
1658 1; 1661 1;
1659 }) { 1662 }) {
1660 $self->message ("Something went wrong deep within the crossfire server. " 1663 $self->message ("Something went wrong deep within the crossfire server. "
1661 . "I'll try to bring you back to the map you were before. " 1664 . "I'll try to bring you back to the map you were before. "
… …
1735 } 1738 }
1736 } 1739 }
1737 }, 1740 },
1738); 1741);
1739 1742
1740=item $client->coro (\&cb) 1743=item $client->async (\&cb)
1741 1744
1742Create a new coroutine, running the specified callback. The coroutine will 1745Create a new coroutine, running the specified callback. The coroutine will
1743be automatically cancelled when the client gets destroyed (e.g. on logout, 1746be automatically cancelled when the client gets destroyed (e.g. on logout,
1744or loss of connection). 1747or loss of connection).
1745 1748
1746=cut 1749=cut
1747 1750
1748sub cf::client::coro { 1751sub cf::client::async {
1749 my ($self, $cb) = @_; 1752 my ($self, $cb) = @_;
1750 1753
1751 my $coro = &cf::async ($cb); 1754 my $coro = &Coro::async ($cb);
1752 1755
1753 $coro->on_destroy (sub { 1756 $coro->on_destroy (sub {
1754 delete $self->{_coro}{$coro+0}; 1757 delete $self->{_coro}{$coro+0};
1755 }); 1758 });
1756 1759
… …
1994 local $/; 1997 local $/;
1995 *CFG = YAML::Syck::Load <$fh>; 1998 *CFG = YAML::Syck::Load <$fh>;
1996 1999
1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2000 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1998 2001
2002 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2003 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2004
1999 if (exists $CFG{mlockall}) { 2005 if (exists $CFG{mlockall}) {
2000 eval { 2006 eval {
2001 $CFG{mlockall} ? &mlockall : &munlockall 2007 $CFG{mlockall} ? &mlockall : &munlockall
2002 and die "WARNING: m(un)lockall failed: $!\n"; 2008 and die "WARNING: m(un)lockall failed: $!\n";
2003 }; 2009 };
… …
2007 2013
2008sub main { 2014sub main {
2009 # we must not ever block the main coroutine 2015 # we must not ever block the main coroutine
2010 local $Coro::idle = sub { 2016 local $Coro::idle = sub {
2011 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2017 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2012 (Coro::unblock_sub {
2013 Event::one_event; 2018 async { Event::one_event };
2014 })->();
2015 }; 2019 };
2016 2020
2017 cfg_load; 2021 cfg_load;
2018 db_load; 2022 db_load;
2019 load_extensions; 2023 load_extensions;
… …
2030 return; 2034 return;
2031 } 2035 }
2032 2036
2033 warn "reloading..."; 2037 warn "reloading...";
2034 2038
2035 local $FREEZE = 1; 2039 my $guard = freeze_mainloop;
2036 cf::emergency_save; 2040 cf::emergency_save;
2037 2041
2038 eval { 2042 eval {
2039 # if anything goes wrong in here, we should simply crash as we already saved 2043 # if anything goes wrong in here, we should simply crash as we already saved
2040 2044
… …
2176 reentrant => 0, 2180 reentrant => 0,
2177 prio => 0, 2181 prio => 0,
2178 at => $NEXT_TICK || $TICK, 2182 at => $NEXT_TICK || $TICK,
2179 data => WF_AUTOCANCEL, 2183 data => WF_AUTOCANCEL,
2180 cb => sub { 2184 cb => sub {
2181 unless ($FREEZE) {
2182 cf::server_tick; # one server iteration 2185 cf::server_tick; # one server iteration
2183 $RUNTIME += $TICK; 2186 $RUNTIME += $TICK;
2184 }
2185
2186 $NEXT_TICK += $TICK; 2187 $NEXT_TICK += $TICK;
2187 2188
2188 # if we are delayed by four ticks or more, skip them all 2189 # if we are delayed by four ticks or more, skip them all
2189 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2190 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2190 2191

Diff Legend

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