… | |
… | |
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->coro (sub { |
… | |
… | |
145 | 0 < aio_read $fh, 0, 16384, my $buf, 0 or next; |
148 | 0 < aio_read $fh, 0, 16384, my $buf, 0 or next; |
146 | $buf =~ /^password (\S+)$/m or next; |
149 | $buf =~ /^password (\S+)$/m or next; |
147 | my $hash = $1; |
150 | my $hash = $1; |
148 | |
151 | |
149 | if ($hash eq crypt $pass, $hash) { |
152 | if ($hash eq crypt $pass, $hash) { |
|
|
153 | nuke_str $pass; |
150 | # password matches, wonderful |
154 | # password matches, wonderful |
151 | my $pl = cf::player::load $plfile or next; |
155 | my $pl = cf::player::load $plfile or next; |
152 | $pl->enable_save (1); |
156 | $pl->enable_save (1); |
153 | $pl->connect ($ns); |
157 | $pl->connect ($ns); |
154 | last; |
158 | last; |
… | |
… | |
160 | . "please try again. If not, you can now decide to take over this account " |
164 | . "please try again. If not, you can now decide to take over this account " |
161 | . "because it has not been in-use for some time.", |
165 | . "because it has not been in-use for some time.", |
162 | cf::NDI_RED |
166 | cf::NDI_RED |
163 | ); |
167 | ); |
164 | |
168 | |
|
|
169 | #TODO: nuke_str |
165 | (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]/ |
166 | or next; |
171 | or next; |
167 | |
172 | |
168 | # check if the file hasn't changed |
173 | # check if the file hasn't changed |
169 | aio_stat $plfile and next; |
174 | aio_stat $plfile and next; |
… | |
… | |
171 | |
176 | |
172 | nuke_playerdir $user; |
177 | nuke_playerdir $user; |
173 | |
178 | |
174 | # fall through to creation |
179 | # fall through to creation |
175 | } else { |
180 | } else { |
|
|
181 | nuke_str $pass; |
|
|
182 | |
176 | Coro::Timer::sleep 1; |
183 | Coro::Timer::sleep 1; |
177 | |
184 | |
178 | $ns->send_drawinfo ( |
185 | $ns->send_drawinfo ( |
179 | "Wrong username or password. Please try again " |
186 | "Wrong username or password. Please try again " |
180 | . "(check for Numlock and other semi-obvious error sources).", |
187 | . "(check for Numlock and other semi-obvious error sources).", |
… | |
… | |
190 | nuke_playerdir $user; |
197 | nuke_playerdir $user; |
191 | |
198 | |
192 | my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again."; |
199 | my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again."; |
193 | |
200 | |
194 | if ($pass2 ne $pass) { |
201 | if ($pass2 ne $pass) { |
|
|
202 | nuke_str $pass; |
|
|
203 | nuke_str $pass2; |
195 | $ns->send_drawinfo ( |
204 | $ns->send_drawinfo ( |
196 | "The passwords do not match, please try again.", |
205 | "The passwords do not match, please try again.", |
197 | cf::NDI_RED |
206 | cf::NDI_RED |
198 | ); |
207 | ); |
199 | next; |
208 | next; |
200 | } |
209 | } |
201 | |
210 | |
|
|
211 | nuke_str $pass2; |
|
|
212 | |
202 | my $pl = cf::player::create; |
213 | my $pl = cf::player::create; |
203 | $pl->ob->name ($user); |
214 | $pl->ob->name ($user); |
204 | $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; |
205 | $pl->connect ($ns); |
217 | $pl->connect ($ns); |
206 | |
218 | |
207 | my $ob = $pl->ob; |
219 | my $ob = $pl->ob; |
208 | |
220 | |
209 | while () { |
221 | while () { |
… | |
… | |
257 | $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."); |
258 | $ob->contr->save (1); |
270 | $ob->contr->save (1); |
259 | |
271 | |
260 | $ob->contr->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 { |
261 | if ($_[0] !~ /^[yY]/) { |
273 | if ($_[0] !~ /^[yY]/) { |
|
|
274 | $ob->contr->invoke (cf::EVENT_PLAYER_LOGOUT, 1); |
262 | $ob->contr->ns->destroy; |
275 | $ob->contr->ns->destroy; |
263 | } else { |
276 | } else { |
264 | $ob->contr->enable_save (1); |
277 | $ob->contr->enable_save (1); |
265 | } |
278 | } |
266 | }); |
279 | }); |
267 | }, |
280 | }, |
268 | ); |
281 | ); |
269 | |
282 | |
270 | cf::client->attach (package => __PACKAGE__); |
283 | cf::player->attach ( |
|
|
284 | on_login => sub { |
|
|
285 | my ($pl) = @_; |
|
|
286 | my $name = $pl->ob->name; |
271 | |
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 | |