misc/infrastructure/keygen/response.d0ir

   1 #!/usr/bin/perl
   2
   3 BEGIN
   4 {
   5         $ENV{PATH} = "/usr/bin:/bin";
   6 }
   7
   8 # if we are suid, set uid := euid
   9 $( = $);
  10 $< = $>;
  11
  12 use strict;
  13 use CGI;
  14 use LWP::Simple;
  15 use MIME::Base64;
  16 use File::Temp;
  17 use DBI;
  18 my $cgi = CGI->new();
  19
  20 sub error($)
  21 {
  22         my ($err) = @_;
  23         print "Content-type: text/plain\n\nd0er $err";
  24         exit 0;
  25 }
  26
  27 sub check_ipfiles($)
  28 {
  29         my ($dir) = @_;
  30         my $ip = $ENV{REMOTE_ADDR};
  31         return 0 if -f "$dir/$ip";
  32         return -1;
  33 }
  34
  35 sub check_dnsbl($$@)
  36 {
  37         my ($goodpatterns, $badpatterns, $list) = @_;
  38
  39         my $name = $ENV{REMOTE_HOST} . ".";
  40         my $addr = $ENV{REMOTE_ADDR};
  41
  42         # check goodpatterns
  43         for(@$goodpatterns)
  44         {
  45                 if($name =~ /^(??{$_})$/ || $addr =~ /^(??{$_})$/)
  46                 {
  47                         return 0;
  48                 }
  49         }
  50         # check badpatterns
  51         for(@$badpatterns)
  52         {
  53                 if($name =~ /^(??{$_})$/ || $addr =~ /^(??{$_})$/)
  54                 {
  55                         warn "$addr/$name blocked by $_";
  56                         return -1;
  57                 }
  58         }
  59
  60         # is he tor?
  61         my $h = gethostbyname $addr;
  62         if(not defined $h)
  63         {
  64                 warn "$addr blocked by gethostbyname()";
  65                 return -1;
  66         }
  67
  68         my $blprefix = join '.', reverse unpack 'C4', $h;
  69         my $i = 0;
  70         for(@$list)
  71         {
  72                 ++$i;
  73                 my $hn = "$blprefix.$_.";
  74                 my $h2 = gethostbyname $hn;
  75                 next
  76                         if not defined $h2;
  77                 my $h2_text = join '.', reverse unpack 'C4', $h2;
  78                 warn "$addr blocked by $hn -> $h2_text";
  79                 return -1;
  80         }
  81
  82         return 0;
  83 }
  84
  85 # MySQL
  86 # create table ip ( id INT AUTO_INCREMENT PRIMARY KEY, ip VARCHAR(64), t DATETIME, error BOOLEAN, INDEX(ip), INDEX(t), INDEX(error) );
  87 # standard SQL
  88 # CREATE TABLE ip ( id INT PRIMARY KEY generated always as identity, ip VARCHAR(64), t TIMESTAMP, error BOOLEAN );
  89 # CREATE INDEX ip_index ON ip ( ip, t, error );
  90 our $__CACHED_DBH__;
  91
  92 sub check_ip_record
  93 {
  94         my ($DBH, $tbl, $ip) = @_;
  95         # MySQL
  96         #my $status = $DBH->selectrow_arrayref("select count(*) from $tbl where ip=? and error=false and t>date_sub(now(), interval 7 day)", undef, $ip)
  97         # standard SQL
  98         my $status = $DBH->selectrow_arrayref("select count(*) from $tbl where ip=? and error=false and t>(now() - interval '7' day)", undef, $ip)
  99                 or die "DBI/DBD: $!";
 100         return $status->[0];
 101 }
 102 sub insert_ip_record
 103 {
 104         my ($DBH, $tbl, $ip) = @_;
 105         # MySQL
 106         #my $status = $DBH->selectall_arrayref("select error, t>date_sub(now(), interval 7 day) from $tbl where ip=?", undef, $ip)
 107         # standard SQL
 108         my $status = $DBH->selectall_arrayref("select error, t>(now() - interval '7' day) from $tbl where ip=?", undef, $ip)
 109                 or die "DBI/DBD: $!";
 110         if(@$status)
 111         {
 112                 if($status->[0][0] || !$status->[0][1]) # error, or after interval
 113                 {
 114                         $DBH->do("update $tbl set error=false, t=now() where ip=?", undef, $ip);
 115                         return 0;
 116                 }
 117                 else # too soon
 118                 {
 119                         return 1;
 120                 }
 121         }
 122         else
 123         {
 124                 $DBH->do("insert into $tbl(ip, error, t) values(?, false, now())", undef, $ip);
 125                 return 0;
 126         }
 127 }
 128 sub delete_ip_record
 129 {
 130         my ($DBH, $tbl, $ip) = @_;
 131         $DBH->do("update $tbl set error=true where ip=?", undef, $ip);
 132 }
 133
 134 sub check_sql($$$$$$$$$)
 135 {
 136         my ($dsn, $u, $p, $tbl, $per32, $per24, $per16, $per8, $inc) = @_;
 137         my $ip = $ENV{REMOTE_ADDR};
 138         my $DBH = ($__CACHED_DBH__ ? $__CACHED_DBH__ : ($__CACHED_DBH__ = DBI->connect($dsn, $u, $p, { RaiseError => 1, AutoCommit => 0 })))
 139                 or die "DBI/DBD: $!";
 140         eval {
 141                 # PostgreSQL defaults to utf8 everywhere so we don't need to set it
 142                 # MySQL defaults to latin1
 143                 #$DBH->do("set character set utf8");
 144                 #$DBH->do("set names utf8");
 145                 #$DBH->do("set time_zone = '+0:00'");
 146                 # standard SQL
 147                 $DBH->do("SET TIME ZONE +0");
 148         } or do {
 149                 undef $__CACHED_DBH__;
 150                 die $@;
 151         };
 152         if($inc < 0)
 153         {
 154                 delete_ip_record($DBH, $tbl, $ip);
 155                 $DBH->commit();
 156                 $DBH->disconnect();
 157                 return 0;
 158         }
 159         elsif($inc == 0)
 160         {
 161                 my $status = check_ip_record($DBH, $tbl, $ip);
 162                 $DBH->disconnect();
 163                 if ($status)
 164                 {
 165                         warn "$ip blocked by SQL";
 166                 }
 167                 return $status;
 168         }
 169         else
 170         {
 171                 my $status = insert_ip_record($DBH, $tbl, $ip);
 172                 $DBH->commit();
 173                 $DBH->disconnect();
 174                 if ($status)
 175                 {
 176                         warn "$ip blocked by SQL";
 177                 }
 178                 return $status;
 179         }
 180 }
 181
 182 sub check_banlist($)
 183 {
 184         my ($s) = @_;
 185         my $ip = $ENV{REMOTE_ADDR};
 186         my @s = split /\n/, get $s;
 187         for(0..@s/4-1)
 188         {
 189                 my $i = $s[4*$_];
 190                 if("$ip." =~ /^\Q$i\E\./)
 191                 {
 192                         warn "$ip blocked by SQL";
 193                         return 1;
 194                 }
 195         }
 196         return 0;
 197 }
 198
 199 our %ca = ();
 200 our $default_ca = 0;
 201
 202 do './config.pl';
 203
 204 if((my $key = $cgi->param('key')))
 205 {
 206         local $| = 1;
 207         undef local $/;
 208
 209         my $ca = $cgi->param('ca');
 210         $ca = $default_ca if not defined $ca;
 211         error "Invalid CA" if not defined $ca{$ca};
 212         error "Not allowed" if not $ca{$ca}->{check}->(1);
 213         my $tempfh = undef;
 214         eval
 215         {
 216                 $tempfh = File::Temp->new();
 217                 binmode $tempfh;
 218                 my $fh = $cgi->upload('key');
 219                 if($fh)
 220                 {
 221                         binmode $fh;
 222                         print $tempfh $_ for <$fh>;
 223                 }
 224                 else
 225                 {
 226                         $key =~ s/ /+/g;
 227                         $key = decode_base64($key);
 228                         print $tempfh $key;
 229                 }
 230                 seek $tempfh, 0, 0;
 231
 232                 $ENV{REQUESTFILE} = $tempfh->filename;
 233                 $ENV{RESPONSEFILE} = $tempfh->filename;
 234                 $ENV{SECRET} = "key_$ca.d0sk";
 235                 open my $errfh, '-|', './crypto-keygen-standalone -P "$SECRET" -j "$REQUESTFILE" -o "$RESPONSEFILE" 2>&1'
 236                         or die "cannot start crypto-keygen-standalone";
 237                 my $err = <$errfh>;
 238                 close $errfh
 239                         or die "crypto-keygen-standalone failed: $err";
 240                 1;
 241         }
 242         or do
 243         {
 244                 $ca{$ca}->{check}->(-1);
 245                 die "$@";
 246         };
 247
 248         print "Content-type: application/octet-stream\n\n";
 249         binmode STDOUT;
 250         print for <$tempfh>;
 251 }
 252 else
 253 {
 254         print <<EOF;
 255 Content-type: text/html
 256
 257 <!doctype html>
 258 <html>
 259 <head>
 260         <title>Xonotic keygen</title>
 261 </head>
 262 <body>
 263         <h1>Xonotic keygen</h1>
 264         <form action="response.d0ir" method="post" enctype="multipart/form-data">
 265         To generate and sign a key IN GAME, follow these steps on the console:
 266         <ol>
 267                 <li>crypto_keygen $default_ca http://ca.xonotic.org/?ca=$default_ca&amp;key=</li>
 268         </ol>
 269         To generate and sign a key MANUALLY, follow these steps on a UNIX command line:
 270         <ol>
 271                 <li>./crypto-keygen-standalone -p key_$default_ca.d0pk -o key_$default_ca.d0si</li>
 272                 <li>./crypto-keygen-standalone -p key_$default_ca.d0pk -I key_$default_ca.d0si -o request.d0iq -O camouflage.d0ic
 273                 <li>Upload the request.d0iq file: <input type="file" name="key"><input type="submit"></li>
 274                 <li>Save the response.d0ir file you are getting</li>
 275                 <li>./crypto-keygen-standalone -p key_$default_ca.d0pk -I key_$default_ca.d0si -c camouflage.d0ic -J response.d0ir -o key_$default_ca.d0si</li>
 276                 <li>Delete request.d0iq, camouflage.d0ic, response.d0ir</li>
 277         </ol>
 278         Your key_$default_ca.d0si key is now signed.
 279         <hr>
 280         To use another CA, please enter its number here before using this page:
 281         <input type="text" name="ca" value="$default_ca" size="2">
 282         <hr>
 283         REMOTE_HOST=$ENV{REMOTE_HOST}<br>
 284         REMOTE_ADDR=$ENV{REMOTE_ADDR}
 285 </body>
 286 </html>
 287 EOF
 288 }