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.141 by root, Fri Jan 5 20:08:53 2007 UTC vs.
Revision 1.154 by root, Tue Jan 9 15:36:19 2007 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 Data::Dumper;
20use Digest::MD5; 21use Digest::MD5;
21use Fcntl; 22use Fcntl;
22use IO::AIO 2.31 (); 23use IO::AIO 2.32 ();
23use YAML::Syck (); 24use YAML::Syck ();
24use Time::HiRes; 25use Time::HiRes;
25 26
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 27use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 28
… …
47our %CFG; 48our %CFG;
48 49
49our $UPTIME; $UPTIME ||= time; 50our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 51our $RUNTIME;
51 52
53our %PLAYER; # all users
52our %MAP; # all maps 54our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 55our $LINK_MAP; # the special {link} map
54our $RANDOM_MAPS = cf::localdir . "/random"; 56our $RANDOM_MAPS = cf::localdir . "/random";
55our %EXT_CORO; 57our %EXT_CORO; # coroutines bound to extensions
56 58
57binmode STDOUT; 59binmode STDOUT;
58binmode STDERR; 60binmode STDERR;
59 61
60# read virtual server time, if available 62# read virtual server time, if available
… …
117 utf8::encode $msg; 119 utf8::encode $msg;
118 120
119 $msg .= "\n" 121 $msg .= "\n"
120 unless $msg =~ /\n$/; 122 unless $msg =~ /\n$/;
121 123
122 LOG llevError, "cfperl: $msg"; 124 LOG llevError, $msg;
123 }; 125 };
124} 126}
125 127
126@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 128@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
127@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 129@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
153 155
154=head2 UTILITY FUNCTIONS 156=head2 UTILITY FUNCTIONS
155 157
156=over 4 158=over 4
157 159
160=item dumpval $ref
161
158=cut 162=cut
163
164sub dumpval {
165 eval {
166 local $SIG{__DIE__};
167 my $d;
168 if (1) {
169 $d = new Data::Dumper([$_[0]], ["*var"]);
170 $d->Terse(1);
171 $d->Indent(2);
172 $d->Quotekeys(0);
173 $d->Useqq(1);
174 #$d->Bless(...);
175 $d->Seen($_[1]) if @_ > 1;
176 $d = $d->Dump();
177 }
178 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
179 $d
180 } || "[unable to dump $_[0]: '$@']";
181}
159 182
160use JSON::Syck (); # TODO# replace by JSON::PC once working 183use JSON::Syck (); # TODO# replace by JSON::PC once working
161 184
162=item $ref = cf::from_json $json 185=item $ref = cf::from_json $json
163 186
… …
333=cut 356=cut
334 357
335############################################################################# 358#############################################################################
336 359
337package cf::path; 360package cf::path;
361
362# used to convert map paths into valid unix filenames by repalcing / by ∕
363our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
338 364
339sub new { 365sub new {
340 my ($class, $path, $base) = @_; 366 my ($class, $path, $base) = @_;
341 367
342 $path = $path->as_string if ref $path; 368 $path = $path->as_string if ref $path;
… …
406# } 432# }
407} 433}
408 434
409# escape the /'s in the path 435# escape the /'s in the path
410sub _escaped_path { 436sub _escaped_path {
411 # ∕ is U+2215
412 (my $path = $_[0]{path}) =~ s/\//∕/g; 437 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
413 $path 438 $path
414} 439}
415 440
416# the original (read-only) location 441# the original (read-only) location
417sub load_path { 442sub load_path {
… …
1071 1096
1072=head2 CORE EXTENSIONS 1097=head2 CORE EXTENSIONS
1073 1098
1074Functions and methods that extend core crossfire objects. 1099Functions and methods that extend core crossfire objects.
1075 1100
1101=cut
1102
1103package cf::player;
1104
1105use Coro::AIO;
1106
1076=head3 cf::player 1107=head3 cf::player
1077 1108
1078=over 4 1109=over 4
1079 1110
1080=item cf::player::exists $login 1111=item cf::player::find $login
1081 1112
1082Returns true when the given account exists. 1113Returns the given player object, loading it if necessary (might block).
1083 1114
1084=cut 1115=cut
1085 1116
1086sub cf::player::exists($) { 1117sub playerdir($) {
1087 cf::player::find $_[0] 1118 cf::localdir
1088 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 1119 . "/"
1120 . cf::playerdir
1121 . "/"
1122 . (ref $_[0] ? $_[0]->ob->name : $_[0])
1123}
1124
1125sub path($) {
1126 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1127
1128 (playerdir $login) . "/$login.pl"
1129}
1130
1131sub find_active($) {
1132 $cf::PLAYER{$_[0]}
1133 and $cf::PLAYER{$_[0]}->active
1134 and $cf::PLAYER{$_[0]}
1135}
1136
1137sub exists($) {
1138 my ($login) = @_;
1139
1140 $cf::PLAYER{$login}
1141 or cf::sync_job { !aio_stat $login }
1142}
1143
1144sub find($) {
1145 return $cf::PLAYER{$_[0]} || do {
1146 my $login = $_[0];
1147
1148 my $guard = cf::lock_acquire "user_find:$login";
1149
1150 $cf::PLAYER{$_[0]} || do {
1151 my $pl = load_pl path $login
1152 or return;
1153 $cf::PLAYER{$login} = $pl
1154 }
1155 }
1156}
1157
1158sub save($) {
1159 my ($pl) = @_;
1160
1161 return if $pl->{deny_save};
1162
1163 my $path = path $pl;
1164 my $guard = cf::lock_acquire "user_save:$path";
1165
1166 return if $pl->{deny_save};
1167
1168 aio_mkdir playerdir $pl, 0770;
1169 $pl->{last_save} = $cf::RUNTIME;
1170
1171 $pl->save_pl ($path);
1172 Coro::cede;
1173}
1174
1175sub new($) {
1176 my ($login) = @_;
1177
1178 my $self = create;
1179
1180 $self->ob->name ($login);
1181 $self->{deny_save} = 1;
1182
1183 $cf::PLAYER{$login} = $self;
1184
1185 $self
1186}
1187
1188=item $pl->quit_character
1189
1190Nukes the player without looking back. If logged in, the connection will
1191be destroyed. May block for a long time.
1192
1193=cut
1194
1195sub quit_character {
1196 my ($pl) = @_;
1197
1198 $pl->{deny_save} = 1;
1199 $pl->password ("*"); # this should lock out the player until we nuked the dir
1200
1201 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1202 $pl->deactivate;
1203 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1204 $pl->ns->destroy if $pl->ns;
1205
1206 my $path = playerdir $pl;
1207 my $temp = "$path~$cf::RUNTIME~deleting~";
1208 aio_rename $path, $temp;
1209 delete $cf::PLAYER{$pl->ob->name};
1210 $pl->destroy;
1211 IO::AIO::aio_rmtree $temp;
1212}
1213
1214=item cf::player::list_logins
1215
1216Returns am arrayref of all valid playernames in the system, can take a
1217while and may block, so not sync_job-capable, ever.
1218
1219=cut
1220
1221sub list_logins {
1222 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
1223 or return [];
1224
1225 my @logins;
1226
1227 for my $login (@$dirs) {
1228 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1229 aio_read $fh, 0, 512, my $buf, 0 or next;
1230 $buf !~ /^password -------------$/ or next; # official not-valid tag
1231
1232 utf8::decode $login;
1233 push @logins, $login;
1234 }
1235
1236 \@logins
1237}
1238
1239=item $player->maps
1240
1241Returns an arrayref of cf::path's of all maps that are private for this
1242player. May block.
1243
1244=cut
1245
1246sub maps($) {
1247 my ($pl) = @_;
1248
1249 my $files = aio_readdir playerdir $pl
1250 or return;
1251
1252 my @paths;
1253
1254 for (@$files) {
1255 utf8::decode $_;
1256 next if /\.(?:pl|pst)$/;
1257 next unless /^$PATH_SEP/;
1258
1259 s/$PATH_SEP/\//g;
1260 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1261 }
1262
1263 \@paths
1089} 1264}
1090 1265
1091=item $player->ext_reply ($msgid, $msgtype, %msg) 1266=item $player->ext_reply ($msgid, $msgtype, %msg)
1092 1267
1093Sends an ext reply to the player. 1268Sends an ext reply to the player.
1094 1269
1095=cut 1270=cut
1096 1271
1097sub cf::player::ext_reply($$$%) { 1272sub ext_reply($$$%) {
1098 my ($self, $id, %msg) = @_; 1273 my ($self, $id, %msg) = @_;
1099 1274
1100 $msg{msgid} = $id; 1275 $msg{msgid} = $id;
1101 1276
1102 $self->send ("ext " . to_json \%msg); 1277 $self->send ("ext " . cf::to_json \%msg);
1103} 1278}
1279
1280package cf;
1104 1281
1105=back 1282=back
1106 1283
1107 1284
1108=head3 cf::map 1285=head3 cf::map
… …
1304 1481
1305 return if $self->{deny_save}; 1482 return if $self->{deny_save};
1306 1483
1307 local $self->{last_access} = $self->last_access;#d# 1484 local $self->{last_access} = $self->last_access;#d#
1308 1485
1486 cf::async {
1487 $_->contr->save for $self->players;
1488 };
1489
1309 if ($uniq) { 1490 if ($uniq) {
1310 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1491 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1311 $self->save_objects ($uniq, cf::IO_UNIQUES); 1492 $self->save_objects ($uniq, cf::IO_UNIQUES);
1312 } else { 1493 } else {
1313 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1494 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
… …
1410} 1591}
1411 1592
1412sub emergency_save { 1593sub emergency_save {
1413 my $freeze_guard = cf::freeze_mainloop; 1594 my $freeze_guard = cf::freeze_mainloop;
1414 1595
1415 warn "enter emergency map save\n"; 1596 warn "enter emergency perl save\n";
1416 1597
1417 cf::sync_job { 1598 cf::sync_job {
1599 warn "begin emergency player save\n";
1600 $_->save for values %cf::PLAYER;
1601 warn "end emergency player save\n";
1602
1418 warn "begin emergency map save\n"; 1603 warn "begin emergency map save\n";
1419 $_->save for values %cf::MAP; 1604 $_->save for values %cf::MAP;
1605 warn "end emergency map save\n";
1420 }; 1606 };
1421 1607
1422 warn "end emergency map save\n"; 1608 warn "leave emergency perl save\n";
1423} 1609}
1424 1610
1425package cf; 1611package cf;
1426 1612
1427=back 1613=back
… …
1526 ($x, $y) = ($map->enter_x, $map->enter_y) 1712 ($x, $y) = ($map->enter_x, $map->enter_y)
1527 if $x <=0 && $y <= 0; 1713 if $x <=0 && $y <= 0;
1528 1714
1529 $map->load; 1715 $map->load;
1530 1716
1717 return unless $self->contr->active;
1531 $self->activate_recursive; 1718 $self->activate_recursive;
1532 $self->enter_map ($map, $x, $y); 1719 $self->enter_map ($map, $x, $y);
1533} 1720}
1534 1721
1535cf::player->attach ( 1722cf::player->attach (
… …
1547 my ($pl) = @_; 1734 my ($pl) = @_;
1548 1735
1549 # try to abort aborted map switching on player login :) 1736 # try to abort aborted map switching on player login :)
1550 # should happen only on crashes 1737 # should happen only on crashes
1551 if ($pl->ob->{_link_pos}) { 1738 if ($pl->ob->{_link_pos}) {
1552
1553 $pl->ob->enter_link; 1739 $pl->ob->enter_link;
1554 (async { 1740 (async {
1555 # we need this sleep as the login has a concurrent enter_exit running 1741 # we need this sleep as the login has a concurrent enter_exit running
1556 # and this sleep increases chances of the player not ending up in scorn 1742 # and this sleep increases chances of the player not ending up in scorn
1557 $pl->ob->reply (undef, 1743 $pl->ob->reply (undef,
… …
1570=cut 1756=cut
1571 1757
1572sub cf::object::player::goto { 1758sub cf::object::player::goto {
1573 my ($self, $path, $x, $y) = @_; 1759 my ($self, $path, $x, $y) = @_;
1574 1760
1761 $path = new cf::path $path;
1762 $path ne "/" or Carp::cluck ("oy");#d#
1763
1575 $self->enter_link; 1764 $self->enter_link;
1576 1765
1577 (async { 1766 (async {
1578 $path = new cf::path $path;
1579
1580 my $map = cf::map::find $path->as_string; 1767 my $map = cf::map::find $path->as_string;
1581 $map = $map->customise_for ($self) if $map; 1768 $map = $map->customise_for ($self) if $map;
1582 1769
1583# warn "entering ", $map->path, " at ($x, $y)\n" 1770# warn "entering ", $map->path, " at ($x, $y)\n"
1584# if $map; 1771# if $map;
1585 1772
1586 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1773 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1587 1774
1588 $self->leave_link ($map, $x, $y); 1775 $self->leave_link ($map, $x, $y);
1589 })->prio (1); 1776 })->prio (1);
1590} 1777}
1591 1778
… …
1999 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 2186 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2000 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 2187 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2001 2188
2002 if (exists $CFG{mlockall}) { 2189 if (exists $CFG{mlockall}) {
2003 eval { 2190 eval {
2004 $CFG{mlockall} ? &mlockall : &munlockall 2191 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2005 and die "WARNING: m(un)lockall failed: $!\n"; 2192 and die "WARNING: m(un)lockall failed: $!\n";
2006 }; 2193 };
2007 warn $@ if $@; 2194 warn $@ if $@;
2008 } 2195 }
2009} 2196}
… …
2103 cf::load_extensions; 2290 cf::load_extensions;
2104 2291
2105 # reattach attachments to objects 2292 # reattach attachments to objects
2106 warn "reattach"; 2293 warn "reattach";
2107 _global_reattach; 2294 _global_reattach;
2295 reattach $_ for values %MAP;
2108 }; 2296 };
2109 2297
2110 if ($@) { 2298 if ($@) {
2111 warn $@; 2299 warn $@;
2112 warn "error while reloading, exiting."; 2300 warn "error while reloading, exiting.";
… …
2128 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2316 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2129 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2317 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2130 2318
2131 # dirty hack because... archetypes are not yet loaded 2319 # dirty hack because... archetypes are not yet loaded
2132 Event->timer ( 2320 Event->timer (
2133 after => 2, 2321 after => 10,
2134 cb => sub { 2322 cb => sub {
2135 $_[0]->w->cancel; 2323 $_[0]->w->cancel;
2136 2324
2137 # provide some exits "home" 2325 # provide some exits "home"
2138 my $exit = cf::object::new "exit"; 2326 my $exit = cf::object::new "exit";

Diff Legend

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