… | |
… | |
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 | |