no more dangerous logging of passwords...
[aymargeddon/current.git] / src / FROGS / DataBase.pm
1 ##########################################################################
2 #
3 #   Copyright (c) 2003 Aymargeddon Development Team
4 #
5 #   This file is part of
6 #   "FROGS" = Framework for Realtime Online Games of Strategy
7 #
8 #   FROGS is free software; you can redistribute it and/or modify it
9 #   under the terms of the GNU General Public License as published by the Free
10 #   Software Foundation; either version 2 of the License, or (at your option)
11 #   any later version.
12 #
13 #   FROGS is distributed in the hope that it will be useful, but WITHOUT
14 #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 #   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
16 #   more details.
17 #   You should have received a copy of the GNU General Public License along
18 #   with this program; if not, write to the Free Software Foundation, Inc., 675
19 #   Mass Ave, Cambridge, MA 02139, USA.
20 #
21 ###########################################################################
22 #
23
24 #
25 # Generell database methods are gathered here.
26 use strict;
27 use DBI;
28 use POSIX qw(floor);
29 use FROGS::Config qw($conf);
30 use FROGS::Util;
31 use Date::Parse qw(str2time);
32 use Date::Calc qw(Time_to_Date Delta_DHMS);
33
34 package DataBase;
35
36 # the constructor connects to the DB
37 sub new{
38   my ($class,$dbh) = @_;
39   my $self = {};
40   if (defined $dbh){
41     $self->{-dbh} = $dbh;
42   }else{
43         $self->{-dbh} = DBI->connect("dbi:$::conf->{-DB_SOURCE}",
44                                        $::conf->{-DB_USER},
45                                        $::conf->{-DB_PASSWD},
46                                        {'RaiseError' => 1, 'AutoCommit' => 0}
47                                                               );
48   }
49   #TODO: should specify iso date and time format explicitly for the session!!
50
51   $self->{-lang} = $self->{-dbh}->quote($::conf->{-DEFAULT_LANGUAGE});
52
53   bless ($self,$class);
54 }
55
56 sub commit{
57   my $self = shift;
58   unless(defined $self->{-nowrite}){
59     $self->{-dbh}->commit();
60     Util::log('committed.',2);
61   }
62 }
63
64 sub nowrite{
65   my $self = shift;
66   Util::log("DataBase: nowrite activated!",1);
67   $self->{-nowrite} = 1;
68 }
69
70 # automaticly called destructor
71 sub DESTROY{
72   my $self = shift;
73   $self->{-dbh}->disconnect();
74 }
75
76 # wrapper for database functions:
77
78 sub quote{
79   my ($self, $text) = @_;
80   return $self->{-dbh}->quote($text);
81 }
82
83 sub quote_all{
84   my ($self, @plain) = @_;
85   my @quoted;
86   for my $s (@plain){
87     push @quoted, $self->{-dbh}->quote($s);
88   }
89   return @quoted;
90 }
91
92 # this does not support any possible SQL-conditions
93 # just a small subset
94 # TODO: this function is really ugly :-(
95 # TODO: just use an escape-character in calls to mark, which fields should be
96 # TODO: quoted
97 sub quote_condition{
98   my ($self, $cond) = @_;
99
100   Util::log("condition: $cond",2);
101
102   my @bracket = ('(',')');
103   my @bool = ('AND', 'OR');
104   my @ops = ('=', '!=');
105   my @noops = ('<'); # forbidden substrings of pairs. ugly workaround for "time < now()"
106
107   # split string at boolean operators
108   my $splitstring = '';
109   for my $bool (@bool){
110     $splitstring .= '\b'.$bool.'\b|';
111   }
112   $splitstring =~ s/(.*)\|/$1/;
113
114   #Util::log("splitstring: $splitstring\n",2);
115
116   my @pairs = split /\s$splitstring\s/, $cond;
117
118   Util::log("pairs: @pairs",2);
119
120   my $opstring = '';
121   for my $o (@ops){
122     $opstring .= "$o|";
123   }
124   $opstring =~ s/(.*)\|/$1/;
125
126   my $noopstring = '';
127   for my $no (@noops){
128     $noopstring .= "$no|";
129   }
130   $noopstring =~ s/(.*)\|/$1/;
131
132   # quote right hand of operator if necessary
133   for my $pair (@pairs){
134     next if $pair =~ /$noopstring/;
135     my ($left,$right) = split /$opstring/, $pair;
136     #Util::log("1 left: $left, right: $right",2);
137     $right =~ s/^\(*-?([\w\s].*)$/$1/; # remove leading brackets
138     #Util::log("2 left: $left, right: $right",2);
139     $right =~ s/-?(.*[\w\s])\)*$/$1/; # remove trailing brackets
140     #Util::log("3 left: $left, right: $right",2);
141     $right =~ s/^\s*-?(\S.*)/$1/; # remove leading whitespace
142     #Util::log("4 left: $left, right: $right",2);
143     $right =~ s/(.*\S)\s*$/$1/; # remove trailing whitespace
144     #Util::log("5 left: $left, right: $right",2);
145
146     next if $right =~ /^\d+$/;
147     # this could be misfunctional in some SQL-Dialect. We assume single-quotes
148     my $qright = ($right =~ /^\'.*\'/) ? $right : $self->quote($right);
149
150     # Util::log("qright: $qright",2);
151     next if $cond =~ /$qright/;
152     $cond =~ s/($opstring\s*)$right/$1$qright/;
153   }
154   Util::log("new condition: $cond",2);
155   return $cond;
156 }
157
158 # assumes that a single row is returned from database
159 # returns a list of selected columns
160 sub single_select{
161   my ($self,$stmt) = @_;
162
163   Util::log("single_select: $stmt",2);
164   my $dat = $self->{-dbh}->selectall_arrayref($stmt);
165   return () if not defined $dat or not defined $dat->[0];
166   return @{$dat->[0]};
167 }
168
169 sub single_hash_select{
170         my ($self,$table,$cond) = @_;
171
172         $cond = $self->quote_condition($cond);
173         my $stmt = "SELECT * FROM $table where $cond";
174         Util::log("single_hash_select: $stmt",2);
175         return $self->{-dbh}->selectrow_hashref($stmt);
176 }       
177
178 sub select_hash{
179   my ($self, $table, $key, $fields, $cond) = @_;
180
181   my $stmt = $fields ? "SELECT $key, $fields FROM $table"
182                      : "SELECT $key FROM $table";
183   $stmt .= " WHERE $cond" if $cond;
184   return $self->{-dbh}->selectall_hashref($stmt, $key);
185 }
186
187 sub select_array{
188   my ($self, $table, $fields, $cond, $order) = @_;
189   my $stmt = "SELECT $fields FROM $table";
190   if( $cond){
191     $cond = $self->quote_condition($cond);
192     $stmt .= " WHERE $cond";
193     if(defined $order){
194       $stmt .= " ORDER BY $order";
195     }
196   }
197
198   Util::log("select_array: $stmt",2);
199   return $self->{-dbh}->selectall_arrayref($stmt);
200 }
201
202 # returns number of fields with given condition
203 sub count{
204   my ($self, $table, $cond) = @_;
205   my $array = $self->select_array($table,'*',$cond);
206   my @a = @$array;
207   my $count = $#a + 1;
208   Util::log("counted $cond in $table: $count",1);
209   return $count;
210 }
211
212 # insert a row in one table of the database
213 #
214 # parameterlist:
215 #   table: the database-table we work on
216 #   hash:  give here a hash with the new values
217 #   noquote: if hash, than dont quote all keys which are in this hash,
218 #            if no hash but defined, than we dont quote all the new values
219 #            (useful for things simmilar to COUNT = COUNT + 1)
220 sub insert_hash{
221   my ($self, $table, $hash,$noquote) = @_;
222   my $noquote_type = ref($noquote);
223   my $noquote_global = 1 if defined $noquote and not $noquote_type eq 'HASH';
224   my $noquote_hash = 1 if $noquote_type eq 'HASH';
225
226   my $insert = "INSERT INTO $table (";
227   for my $key (keys %$hash){
228     # $key = $self->{-dbh}->quote_identifier($key);
229     $insert .= "$key,";
230   }
231   chop($insert);
232   $insert .=") VALUES (";
233   while( my ($k,$val) = each %$hash){
234     $val = $self->quote($val) if not $noquote_global or
235       ($noquote_hash and exists $noquote->{$k});
236     $insert .= "$val,";
237   }
238   chop($insert);
239   $insert .= ')';
240
241   Util::log("INSERT: $insert",2);
242   my $h = $self->{-dbh}->prepare($insert);
243   $h->execute();
244   $h->finish();
245 }
246
247 # parameter: see insert_hash() and update_hash()
248 sub insert_or_update_hash{
249   my ($self, $table, $cond, $hash, $noquote) = @_;
250   $cond = $self->quote_condition($cond);
251   my @row = $self->single_select("SELECT * FROM $table WHERE $cond");
252   use Data::Dumper;
253   if($#row >= 0){
254     $self->update_hash($table,$cond,$hash,$noquote);
255   }else{
256     $self->insert_hash($table,$hash,$noquote);
257   }
258 }
259
260 # update a set of rows in one table of the database
261 #
262 # parameterlist:
263 #   table: the database-table we work on
264 #   cond:  only rows are effected, which evaluates this condition as true
265 #   hash:  give here a hash with the new values
266 #   noquote: if hash, than dont quote all keys which are in this hash,
267 #            if no hash but defined, than we dont quote all the new values
268 #            (useful for things simmilar to COUNT = COUNT + 1)
269 sub update_hash{
270   my ($self, $table, $cond, $hash, $noquote) = @_;
271   my $noquote_type = ref($noquote);
272   my $noquote_global = 1 if defined $noquote and not $noquote_type eq 'HASH';
273   my $noquote_hash = 1 if $noquote_type eq 'HASH';
274
275   my $stmt = "UPDATE $table SET ";
276   while( my ($k,$v) = each %$hash){
277     $v = $self->quote($v) if not $noquote_global or
278       ($noquote_hash and exists $noquote->{$k});
279     $stmt .= "$k=$v,";
280   }
281   chop($stmt);
282
283   $stmt .= " WHERE ". $self->quote_condition($cond);
284
285   Util::log("update_hash: $stmt",2);
286   my $h = $self->{-dbh}->prepare($stmt);
287   $h->execute();
288   $h->finish();
289 }
290
291 sub delete_from{
292   my ($self,$table,$cond) = @_;
293
294   die "do you really want to delete a complete table?" unless $cond;
295
296   my $sql = "DELETE FROM $table";
297   if($cond){
298     $cond = $self->quote_condition($cond);
299     $sql .= " WHERE $cond";
300   }
301   Util::log($sql,2);
302   my $dbh = $self->{-dbh};
303   my $h = $dbh->prepare($sql);
304   $h->execute();
305   $h->finish();
306 }
307
308 sub find_first_free{
309   my ($self,$table,$field) = @_;
310
311   my $t = $self->select_array($table, $field);
312   my @ids = sort {$a <=> $b} (map {$_->[0]} @$t);
313
314   my $id = 1;
315   for my $try (@ids){
316     next if $try < 0; # unfortunately some tabels contain the id -1 and id 0 is free :-(
317     last if $id < $try;
318     $id = $try + 1;
319   }
320   return $id;
321 }
322
323 sub read_game{
324   my ($self,$game,$field) = @_;
325   my $stmt = "SELECT $field from GAME where GAME=$game";
326   return $self->single_select($stmt);
327 }
328
329 # localisation
330
331 sub set_language{
332   my ($self, $lang) = @_;
333   $self->{-lang} = $self->{-dbh}->quote($lang) if $lang;
334 }
335
336 # returns the localisation of a tag. 
337 # if the result contains tags again, localize these too.
338 sub loc{
339   my ($self, $tag, @args) = @_;
340
341   Util::log("args: @args",2);
342
343   $tag = $self->{-dbh}->quote($tag);
344   my $stmt = 'SELECT TEXT FROM LOCALIZE WHERE LANGUAGE='.$self->{-lang}." AND TAG=$tag";
345   my ($text) = $self->single_select($stmt);
346
347   # replace %x with arg[x]
348   while($text =~ /\%(\d+)/){
349     my $nr = $1;
350     Util::log("found $nr in $text",2);
351     $text =~ s/(\%$nr)/$args[$nr-1]/g;
352   }
353
354   return $text =~ /^\s*$/ ? "Error: Tag $tag not defined for language $self->{-lang}."
355     : $self->localize_string($text);
356 }
357
358 # calls loc() for all uppercase-only-words and returns new string
359 # TODO: allow arguments in brackets after uppercase-words with length >= 3
360 sub localize_string{
361   my ($self,$string) = @_;
362
363   $string =~ s/(\b[^\Wa-z0-9]{3,}\b)/$self->loc($1)/ge;
364   return $string;
365 }
366
367 # game management:
368
369 sub new_account{
370   my ($self,$login,$name,$email,$lang) = @_;
371
372   my ($qlogin,$qname,$qemail) = $self->quote_all($login,$name,$email);
373
374   my $cond = "LOGIN=$qlogin OR REALNAME=$qname OR EMAIL=$qemail";
375   my $habschon = $self->select_array('PLAYER','PLAYER',$cond);
376   my @habschon = @$habschon;
377   return 0 if @habschon;
378
379   # generate new password
380   my $pwd = '';
381   my $allowed = '2345679ACDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
382   for my $i (0..7){
383     $pwd .= substr($allowed, POSIX::floor(rand(72)), 1);
384   }
385   my $qpwd = $self->{-dbh}->quote($pwd);
386
387   # search first free player ID
388   my $player = $self->find_first_free('PLAYER','PLAYER');
389
390   # write new player
391   $self->insert_hash('PLAYER', {PLAYER   => $player,
392                                 REALNAME => $name,
393                                 LOGIN    => $login,
394                                 EMAIL    => $email,
395                                 PASSWORD => $pwd,
396                                 LANGUAGE => $lang,
397                                });
398   $self->commit();
399
400   my $mail = "From: registration\@aymargeddon.de\nTo: $name <$email>\n"
401            . "Subject: ".$self->loc('REGISTER_MAIL_SUBJECT')."\n\n"
402            . $self->loc('REGISTER_MAIL_TEXT', $name, $login, $pwd)."\n";
403
404   # print $mail;
405
406   open(SENDMAIL, "|mail $email") or Util::log("Can't fork for sendmail: $!",0);
407   print SENDMAIL $mail;
408   close(SENDMAIL) or Util::log("sendmail didn't close nicely",0);
409
410   return $pwd;
411 }
412
413 sub authenticate{
414   my ($self, $user, $pwd, $pwd2, $pwd3 ) = @_;
415
416   my $admin = $self->quote('admin');
417   # you can log into any account with adminpassword
418   my ($adminpwd) = $self->single_select("SELECT PASSWORD FROM PLAYER ".
419                                         "WHERE LOGIN=$admin");
420   ($user,$pwd,$adminpwd) = $self->quote_all($user,$pwd,$adminpwd);
421
422
423   # Util::log("Adminpassword: $adminpwd, password: $pwd",2);
424
425   my ($player, $sec);
426   if($adminpwd eq $pwd){
427     my $stmt = "SELECT PLAYER,SECURITY FROM PLAYER WHERE ".
428       "LOGIN=$user";
429     ($player, $sec) = $self->single_select($stmt);
430   }else{
431     my $stmt = "SELECT PLAYER,SECURITY FROM PLAYER WHERE ".
432     "LOGIN=$user AND PASSWORD=$pwd";
433     ($player, $sec) = $self->single_select($stmt);
434   }
435
436   if($player){
437     if($pwd2 and $pwd3 and $pwd2 eq $pwd3){
438       # change password!
439       $self->update_hash('PLAYER',
440                          "LOGIN=$user",
441                          {'PASSWORD' => $pwd2});
442       Util::log("password changed!",0); # todo: localize and aufhübschen
443     }
444     # TODO: write last_login
445     return $player;
446   }
447   return 0;
448 }
449
450 sub write_event{
451   my ($self, $content) = @_;
452
453   $self->insert_hash('EVENT', $content);
454 }
455
456 sub read_event{
457   my ($self, $id) = @_;
458
459   my $e = $self->single_hash_select('EVENT',"ID=$id");
460   my @args;
461   for my $a (1..($::conf->{-MAX_ARGS})){
462     Util::log("search for ARG$a...",2);
463     push @args, $e->{"ARG$a"};
464   }
465
466   Util::log("args in read_event: @args",2);
467
468   my ($loc,$to);
469   $to = $e->{'LOCATION'} || 'Game';
470
471   return ($to,$e->{'TIME'},$self->loc($e->{'TAG'},@args));
472 }
473
474 sub delete_event{
475   my ($self, $id) = @_;
476   $self->delete_from('EVENT',"ID=$id");
477 }
478
479 sub send_message{
480   my ($self, $msg_hash) = @_;
481
482   $msg_hash->{'TIME'} = $self->now();
483   $self->insert_hash('MESSAGE',$msg_hash);
484 }
485
486 sub read_message{
487   my ($self, $id) = @_;
488
489   my $stmt = "SELECT TIME, MFROM, MSG_TAG, MSG_TEXT, ARG1, ARG2, ARG3, ARG4 ".
490     "FROM MESSAGE WHERE ID=$id";
491   my ($time, $from, $tag, $text, @args) = $self->single_select($stmt);
492
493   # localize it
494   if($tag){
495     # print "tag!";
496     $text = $self->loc($tag, @args);
497     return ($time, $from, $text, @args);
498   }elsif($text){
499     # print "text!";
500     $text = $self->localize_string($text) unless $from;
501     return ($time, $from, $text);
502   }else{
503     return (0, 'unknown message type error in DataBase');
504   }
505 }
506
507 sub delete_message{
508   my ($self, $id) = @_;
509
510   $self->delete_from('MESSAGE',"ID=$id");
511 }
512
513 sub read_player{
514   my ($self,$player,$field) = @_;
515   my $stmt = "SELECT $field from PLAYER where PLAYER=$player";
516   return $self->single_select($stmt);
517 }
518
519 # returns all games for id -1 (admin)
520 sub games_of_player{
521   my ($self,$player) = @_;
522
523   if($player > 0){
524     return $self->select_array('ROLE','GAME',"PLAYER=$player");
525   }else{
526     return $self->select_array('GAME','GAME');
527   }
528 }
529
530 sub open_games{
531   my ($self,$cond) = @_;
532   my $games = $self->select_array('GAME','GAME');
533
534   my @log;
535   for my $game (@$games){
536       Util::log( Dumper($game)."\n",1);
537     my $c = "GAME=". $game->[0];
538     $c .= " AND $cond" if $cond;
539       Util::log($c."\n",1);
540     my $unused = $self->select_array('MAP','LOCATION','',$c);
541     
542     print $unused;
543
544       Util::log(Dumper(@$unused),1);
545       
546     push @log, $game->[0] if @$unused + 1;
547   }
548   return \@log;
549 }
550
551 sub read_single_mobile{
552   my($self,$id) = @_;
553
554   return $self->single_hash_select('MOBILE',"ID=$id");
555 }
556
557 sub now{
558   my $self = shift;
559   my ($ret) = $self->single_select("SELECT NOW()");
560   return $ret;
561 }
562
563 # generates a relative time string from an absolute time
564 sub relative{
565   my ($self, $absolute) = @_;
566
567   my $now = $self->now();
568   # print "now: $now\nabsolute: $absolute\n";
569
570   my $now_unix = Date::Parse::str2time($now,'GMT');
571   my $absolute_unix = Date::Parse::str2time($absolute,'GMT');
572   # print "now_unix: $now_unix\nabsolute_unix: $absolute_unix\n";
573   my $diff = $absolute_unix - $now_unix;
574
575   if($diff > 0){
576
577     my ($days,$hours,$minutes,$seconds) = 
578       Date::Calc::Delta_DHMS(1970,1,1,0,0,0,Date::Calc::Time_to_Date($diff));
579
580     if($days){
581       return $self->loc('TIME_WITH_DAYS',$days,$hours,$minutes,$seconds);
582     }elsif($hours){
583       return $self->loc('TIME_WITH_HOURS',$hours,$minutes,$seconds);
584     }elsif($minutes){
585       return $self->loc('TIME_WITH_MINUTES',$minutes,$seconds);
586     }else{
587       return $self->loc('TIME_WITH_SECONDS',$seconds);
588     }
589   }else{ # $diff <= 0
590     return '';
591   }
592 }
593
594 1;
595
596