| … | |
… | |
| 5 | use Fcntl; |
5 | use Fcntl; |
| 6 | use Coro::AIO; |
6 | use Coro::AIO; |
| 7 | |
7 | |
| 8 | my $PLAYERDIR = sprintf "%s/%s", cf::localdir, cf::playerdir; |
8 | my $PLAYERDIR = sprintf "%s/%s", cf::localdir, cf::playerdir; |
| 9 | |
9 | |
| 10 | # testbed for coroutines in crossfire : |
10 | # paranoia function to overwrite a string-in-place |
|
|
11 | sub nuke_str { |
|
|
12 | substr $_[0], 0, (length $_[0]), "x" x length $_[0] |
|
|
13 | } |
| 11 | |
14 | |
| 12 | sub query { |
15 | sub query { |
| 13 | my ($ns, $flags, $text) = @_; |
16 | my ($ns, $flags, $text) = @_; |
| 14 | |
17 | |
| 15 | my $current = $Coro::current; |
18 | my $current = $Coro::current; |
| … | |
… | |
| 60 | system "cd \Q$PLAYERDIR\E " |
63 | system "cd \Q$PLAYERDIR\E " |
| 61 | . "&& mv \Q$user\E ~\Q$Coro::current\E~deleting~ 2>/dev/null " |
64 | . "&& mv \Q$user\E ~\Q$Coro::current\E~deleting~ 2>/dev/null " |
| 62 | . "&& (rm -rf ~\Q$Coro::current\E~deleting~ &)"; |
65 | . "&& (rm -rf ~\Q$Coro::current\E~deleting~ &)"; |
| 63 | } |
66 | } |
| 64 | |
67 | |
| 65 | sub on_addme { |
68 | sub addme { |
| 66 | my ($ns) = @_; |
69 | my ($ns) = @_; |
| 67 | |
70 | |
| 68 | $ns->destroy if $ns->pl; |
71 | $ns->destroy if $ns->pl; |
| 69 | |
72 | |
| 70 | $ns->coro (sub { |
73 | $ns->async (sub { |
| 71 | my ($user, $pass); |
74 | my ($user, $pass); |
| 72 | |
75 | |
| 73 | $ns->send_packet ("addme_success"); |
76 | $ns->send_packet ("addme_success"); |
| 74 | |
77 | |
| 75 | for (;;) { |
78 | for (;;) { |
| … | |
… | |
| 81 | ); |
84 | ); |
| 82 | |
85 | |
| 83 | # read username |
86 | # read username |
| 84 | while () { |
87 | while () { |
| 85 | $user = query $ns, 0, "What is your name?\n:"; |
88 | $user = query $ns, 0, "What is your name?\n:"; |
| 86 | last if $user =~ /^[a-zA-Z0-9][a-zA-Z0-9\-_]{2,17}$/; |
89 | |
|
|
90 | if ($cf::LOGIN_LOCK{$user}) { |
| 87 | $ns->send_drawinfo ( |
91 | $ns->send_drawinfo ( |
|
|
92 | "That username is currently used in another login session. " |
|
|
93 | . "Chose another, or wait till the other session has ended.", |
|
|
94 | cf::NDI_RED |
|
|
95 | ); |
|
|
96 | } elsif ($user =~ /^[a-zA-Z0-9][a-zA-Z0-9\-_]{2,17}$/) { |
|
|
97 | last; |
|
|
98 | } else { |
|
|
99 | $ns->send_drawinfo ( |
| 88 | "Your username contains illegal characters " |
100 | "Your username contains illegal characters " |
| 89 | . "(only a-z, A-Z and 0-9 are allowed), " |
101 | . "(only a-z, A-Z and 0-9 are allowed), " |
| 90 | . "or is not between 3 and 18 characters in length.", |
102 | . "or is not between 3 and 18 characters in length.", |
| 91 | cf::NDI_RED |
103 | cf::NDI_RED |
| 92 | ); |
104 | ); |
|
|
105 | } |
| 93 | } |
106 | } |
| 94 | |
107 | |
| 95 | check_playing $ns, $user and next; |
108 | check_playing $ns, $user and next; |
| 96 | |
109 | |
| 97 | $ns->send_drawinfo ( |
110 | $ns->send_drawinfo ( |
| … | |
… | |
| 110 | . "that cannot be too much to ask for :)", |
123 | . "that cannot be too much to ask for :)", |
| 111 | cf::NDI_RED |
124 | cf::NDI_RED |
| 112 | ); |
125 | ); |
| 113 | } |
126 | } |
| 114 | |
127 | |
| 115 | check_playing $ns, $user and next; |
|
|
| 116 | |
|
|
| 117 | my $dir = "$PLAYERDIR/$user"; |
128 | my $dir = "$PLAYERDIR/$user"; |
| 118 | my $plfile = "$dir/$user.pl"; |
129 | my $plfile = "$dir/$user.pl"; |
|
|
130 | |
|
|
131 | # lock this username for the remainder of this login session |
|
|
132 | if ($cf::LOGIN_LOCK{$user}) { |
|
|
133 | $ns->send_drawinfo ( |
|
|
134 | "That username is currently used in another login session. " |
|
|
135 | . "Chose another, or wait till the other session has ended.", |
|
|
136 | cf::NDI_RED |
|
|
137 | ); |
|
|
138 | next; |
|
|
139 | } |
|
|
140 | local $cf::LOGIN_LOCK{$user} = 1; |
|
|
141 | |
|
|
142 | check_playing $ns, $user and next; |
| 119 | |
143 | |
| 120 | # try to read the user file and check the password |
144 | # try to read the user file and check the password |
| 121 | if (my $fh = aio_open $plfile, O_RDONLY, 0) { |
145 | if (my $fh = aio_open $plfile, O_RDONLY, 0) { |
| 122 | my $mtime = (stat $fh)[9]; |
146 | my $mtime = (stat $fh)[9]; |
| 123 | |
147 | |
| 124 | 0 < aio_read $fh, 0, 16384, my $buf, 0 or next; |
148 | 0 < aio_read $fh, 0, 16384, my $buf, 0 or next; |
| 125 | $buf =~ /^password (\S+)$/m or next; |
149 | $buf =~ /^password (\S+)$/m or next; |
| 126 | my $hash = $1; |
150 | my $hash = $1; |
| 127 | |
151 | |
| 128 | check_playing $ns, $user and next; |
|
|
| 129 | |
|
|
| 130 | if ($hash eq crypt $pass, $hash) { |
152 | if ($hash eq crypt $pass, $hash) { |
|
|
153 | nuke_str $pass; |
| 131 | # password matches, wonderful |
154 | # password matches, wonderful |
| 132 | my $pl = cf::player::load $plfile or next; |
155 | my $pl = cf::player::load $plfile or next; |
| 133 | $pl->enable_save (1); |
156 | $pl->enable_save (1); |
| 134 | $pl->connect ($ns); |
157 | $pl->connect ($ns); |
| 135 | last; |
158 | last; |
| 136 | } |
|
|
| 137 | |
|
|
| 138 | if (can_cleanup $buf, $mtime) { |
159 | } elsif (can_cleanup $buf, $mtime) { |
| 139 | Coro::Timer::sleep 1; |
160 | Coro::Timer::sleep 1; |
| 140 | |
161 | |
| 141 | $ns->send_drawinfo ( |
162 | $ns->send_drawinfo ( |
| 142 | "Player exists, but password does not match. If this is you account, " |
163 | "Player exists, but password does not match. If this is your account, " |
| 143 | . "please try again. If not, you can now opt to take over this account " |
164 | . "please try again. If not, you can now decide to take over this account " |
| 144 | . "because it has not been in-use for some time.", |
165 | . "because it has not been in-use for some time.", |
| 145 | cf::NDI_RED |
166 | cf::NDI_RED |
| 146 | ); |
167 | ); |
| 147 | |
168 | |
|
|
169 | #TODO: nuke_str |
| 148 | (query $ns, cf::CS_QUERY_SINGLECHAR, "Delete existing account and create a new one (Y/N)?") =~ /^[yY]/ |
170 | (query $ns, cf::CS_QUERY_SINGLECHAR, "Delete existing account and create a new one (Y/N)?") =~ /^[yY]/ |
| 149 | or next; |
171 | or next; |
| 150 | |
172 | |
| 151 | # check if the file hasn't changed |
173 | # check if the file hasn't changed |
| 152 | aio_stat $plfile or next; |
174 | aio_stat $plfile and next; |
| 153 | $mtime == (stat _)[9] or next; |
175 | $mtime == (stat _)[9] or next; |
| 154 | |
176 | |
| 155 | # nuke playerdir, this might block, but it needs to be atomic |
|
|
| 156 | nuke_playerdir $user; |
177 | nuke_playerdir $user; |
| 157 | |
178 | |
| 158 | # fall through to creation |
179 | # fall through to creation |
| 159 | } else { |
180 | } else { |
|
|
181 | nuke_str $pass; |
|
|
182 | |
| 160 | Coro::Timer::sleep 1; |
183 | Coro::Timer::sleep 1; |
| 161 | |
184 | |
| 162 | $ns->send_drawinfo ( |
185 | $ns->send_drawinfo ( |
| 163 | "Wrong username or password. Please try again " |
186 | "Wrong username or password. Please try again " |
| 164 | . "(check for Numlock and other semi-obvious error sources).", |
187 | . "(check for Numlock and other semi-obvious error sources).", |
| … | |
… | |
| 167 | next; |
190 | next; |
| 168 | } |
191 | } |
| 169 | } |
192 | } |
| 170 | |
193 | |
| 171 | # the rest of this function is character creation |
194 | # the rest of this function is character creation |
| 172 | check_playing $ns, $user and next; |
|
|
| 173 | |
195 | |
|
|
196 | # just to make sure nothing is left over |
| 174 | nuke_playerdir $user; |
197 | nuke_playerdir $user; |
|
|
198 | |
|
|
199 | my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again."; |
|
|
200 | |
|
|
201 | if ($pass2 ne $pass) { |
|
|
202 | nuke_str $pass; |
|
|
203 | nuke_str $pass2; |
|
|
204 | $ns->send_drawinfo ( |
|
|
205 | "The passwords do not match, please try again.", |
|
|
206 | cf::NDI_RED |
|
|
207 | ); |
|
|
208 | next; |
|
|
209 | } |
|
|
210 | |
|
|
211 | nuke_str $pass2; |
| 175 | |
212 | |
| 176 | my $pl = cf::player::create; |
213 | my $pl = cf::player::create; |
| 177 | $pl->ob->name ($user); |
214 | $pl->ob->name ($user); |
| 178 | $pl->password (crypt $pass, join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]); |
215 | $pl->password (crypt $pass, join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]); |
|
|
216 | nuke_str $pass; |
| 179 | $pl->connect ($ns); |
217 | $pl->connect ($ns); |
|
|
218 | |
| 180 | my $ob = $pl->ob; |
219 | my $ob = $pl->ob; |
| 181 | |
220 | |
| 182 | while () { |
221 | while () { |
| 183 | $ob->update_stats; |
222 | $ob->update_stats; |
| 184 | $pl->save_stats; |
223 | $pl->save_stats; |
| … | |
… | |
| 205 | $ns->send_drawinfo ($ob->msg, cf::NDI_BLUE); |
244 | $ns->send_drawinfo ($ob->msg, cf::NDI_BLUE); |
| 206 | $ns->send_packet (sprintf "query %d %s", cf::CS_QUERY_SINGLECHAR, |
245 | $ns->send_packet (sprintf "query %d %s", cf::CS_QUERY_SINGLECHAR, |
| 207 | "Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n"); |
246 | "Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n"); |
| 208 | |
247 | |
| 209 | $ns->state (cf::ST_CHANGE_CLASS); |
248 | $ns->state (cf::ST_CHANGE_CLASS); |
|
|
249 | $pl->enable_save (1);#d# too early |
| 210 | |
250 | |
| 211 | last; |
251 | last; |
| 212 | } |
252 | } |
| 213 | }); |
253 | }); |
| 214 | } |
254 | } |
| … | |
… | |
| 218 | on_apply => sub { |
258 | on_apply => sub { |
| 219 | my ($bed, $ob) = @_; |
259 | my ($bed, $ob) = @_; |
| 220 | |
260 | |
| 221 | return cf::override 0 unless $ob->type == cf::PLAYER; |
261 | return cf::override 0 unless $ob->type == cf::PLAYER; |
| 222 | |
262 | |
| 223 | my $ns = $ob->contr->ns; |
|
|
| 224 | |
|
|
| 225 | # update respawn position |
263 | # update respawn position |
| 226 | $ob->contr->savebed ($bed->map->path, $bed->x, $bed->y); |
264 | $ob->contr->savebed ($bed->map->path, $bed->x, $bed->y); |
| 227 | |
265 | |
| 228 | #TODO? |
|
|
| 229 | #strcpy (pl->contr->killer, "left"); |
266 | $ob->contr->killer ("left"); |
| 230 | #check_score (pl); /* Always check score */ |
267 | $ob->check_score; |
| 231 | |
268 | |
| 232 | $ob->reply (undef, "In the future, you will wake up here when you die."); |
269 | $ob->reply (undef, "In the future, you will wake up here when you die."); |
| 233 | $ob->contr->save (); |
270 | $ob->contr->save (1); |
| 234 | |
271 | |
| 235 | $ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub { |
272 | $ob->contr->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub { |
| 236 | if ($_[0] !~ /^[yY]/) { |
273 | if ($_[0] !~ /^[yY]/) { |
|
|
274 | $ob->contr->invoke (cf::EVENT_PLAYER_LOGOUT, 1); |
|
|
275 | $ob->contr->ns->destroy; |
|
|
276 | } else { |
| 237 | $ob->contr->save (1); |
277 | $ob->contr->enable_save (1); |
| 238 | $ns->destroy (); |
|
|
| 239 | } |
278 | } |
| 240 | }); |
279 | }); |
| 241 | }, |
280 | }, |
| 242 | ); |
281 | ); |
| 243 | |
282 | |
| 244 | cf::client->attach (package => __PACKAGE__); |
283 | cf::player->attach ( |
|
|
284 | on_login => sub { |
|
|
285 | my ($pl) = @_; |
|
|
286 | my $name = $pl->ob->name; |
| 245 | |
287 | |
|
|
288 | $_->ob->message ("$name has entered the game.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
|
|
289 | }, |
|
|
290 | on_logout => sub { |
|
|
291 | my ($pl, $cleanly) = @_; |
|
|
292 | my $name = $pl->ob->name; |
|
|
293 | |
|
|
294 | if ($cleanly) { |
|
|
295 | $_->ob->message ("$name left the game.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
|
|
296 | } else { |
|
|
297 | $_->ob->message ("$name uncerimoniously disconnected.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
|
|
298 | } |
|
|
299 | }, |
|
|
300 | ); |
|
|
301 | |
|
|
302 | cf::client->attach ( |
|
|
303 | on_addme => \&addme, |
|
|
304 | ); |
|
|
305 | |
