misc/infrastructure/keygen/response.d0ir

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use CGI;
   5 use LWP::Simple;
   6 use MIME::Base64;
   7 use File::Temp;
   8 use DBI;
   9 my $cgi = CGI->new();
  10
  11 sub error($)
  12 {
  13         my ($err) = @_;
  14         print "Content-type: text/plain\n\nd0er $err";
  15         exit 0;
  16 }
  17
  18 sub check_dnsbl($$@)
  19 {
  20         my ($goodpatterns, $badpatterns, $list) = @_;
  21
  22         my $name = $ENV{REMOTE_HOST} . ".";
  23         my $addr = $ENV{REMOTE_ADDR};
  24
  25         # check goodpatterns
  26         for(@$goodpatterns)
  27         {
  28                 return 0
  29                         if $name =~ /^(??{$_})$/ || $addr =~ /^(??{$_})$/;
  30         }
  31         # check badpatterns
  32         for(@$badpatterns)
  33         {
  34                 return -1
  35                         if $name =~ /^(??{$_})$/ || $addr =~ /^(??{$_})$/;
  36         }
  37
  38         # is he tor?
  39         my $h = gethostbyname $addr;
  40         return -1
  41                 if not defined $h;
  42
  43         my $blprefix = join '.', reverse unpack 'C4', $h;
  44         my $i = 0;
  45         for(@$list)
  46         {
  47                 ++$i;
  48                 my $hn = "$blprefix.$_.";
  49                 my $h2 = gethostbyname $hn;
  50                 next
  51                         if not defined $h2;
  52                 return -1;
  53         }
  54
  55         return 0;
  56 }
  57
  58 # create table ip ( id INT AUTO_INCREMENT PRIMARY KEY, ip VARCHAR(64), t DATETIME, error BOOLEAN, INDEX(ip), INDEX(t), INDEX(error) );
  59 our $__CACHED_DBH__;
  60
  61 sub check_sql($$$$$)
  62 {
  63         my ($dsn, $u, $p, $tbl, $inc) = @_;
  64         my $ip = $ENV{REMOTE_ADDR};
  65         my $DBH = ($__CACHED_DBH__ ? $__CACHED_DBH__ : ($__CACHED_DBH__ = DBI->connect($dsn, $u, $p, { RaiseError => 1, AutoCommit => 0 })))
  66                 or die "DBI/DBD: $!";
  67         $DBH->do("set character set utf8");
  68         $DBH->do("set names utf8");
  69         if($inc < 0)
  70         {
  71                 $DBH->do("update $tbl set error=true where ip=?", undef, $ip);
  72                 $DBH->commit();
  73                 $DBH->disconnect();
  74                 return 0;
  75         }
  76         elsif($inc == 0)
  77         {
  78                 my $status = $DBH->selectrow_arrayref("select count(*) from $tbl where ip=? and error=false and t>date_sub(now(), interval 7 day)", undef, $ip)
  79                         or die "DBI/DBD: $!";
  80                 $DBH->disconnect();
  81                 return $status->[0] ? -1 : 0;
  82         }
  83         else
  84         {
  85                 my $status = $DBH->selectall_arrayref("select error, t>date_sub(now(), interval 7 day) from $tbl where ip=?", undef, $ip)
  86                         or die "DBI/DBD: $!";
  87                 if(@$status)
  88                 {
  89                         if($status->[0][0] || !$status->[0][1]) # error, or after interval
  90                         {
  91                                 $DBH->do("update $tbl set error=false, t=now() where ip=?", undef, $ip);
  92                                 $DBH->commit();
  93                                 $DBH->disconnect();
  94                                 return 0;
  95                         }
  96                         else # too soon
  97                         {
  98                                 $DBH->disconnect();
  99                                 return -1;
 100                         }
 101                 }
 102                 else
 103                 {
 104                         $DBH->do("insert into $tbl(ip, error, t) values(?, false, now())", undef, $ip);
 105                         $DBH->commit();
 106                         $DBH->disconnect();
 107                         return 0;
 108                 }
 109         }
 110 }
 111
 112 sub check_banlist($)
 113 {
 114         my ($s) = @_;
 115         my $ip = $ENV{REMOTE_ADDR};
 116         my @s = split /\n/, get $s;
 117         for(0..@s/4-1)
 118         {
 119                 my $i = $s[4*$_];
 120                 return 1 if "$ip." =~ /^\Q$i\E\./;
 121         }
 122         return 0;
 123 }
 124
 125 our %ca = ();
 126 our $default_ca = 0;
 127
 128 do 'config.pl';
 129
 130 if((my $key = $cgi->param('key')))
 131 {
 132         local $| = 1;
 133         undef local $/;
 134
 135         my $ca = $cgi->param('ca');
 136         $ca = $default_ca if not defined $ca;
 137         error "Invalid CA" if not defined $ca{$ca};
 138         error "Not allowed" if not $ca{$ca}->{check}->(1);
 139         my $tempfh = undef;
 140         eval
 141         {
 142                 $tempfh = File::Temp->new();
 143                 binmode $tempfh;
 144                 my $fh = $cgi->upload('key');
 145                 if($fh)
 146                 {
 147                         binmode $fh;
 148                         print $tempfh $_ for <$fh>;
 149                 }
 150                 else
 151                 {
 152                         $key =~ s/ /+/g;
 153                         $key = decode_base64($key);
 154                         print $tempfh $key;
 155                 }
 156                 seek $tempfh, 0, 0;
 157
 158                 $ENV{REQUESTFILE} = $tempfh->filename;
 159                 $ENV{RESPONSEFILE} = $tempfh->filename;
 160                 $ENV{SECRET} = "key_$ca.d0sk";
 161                 open my $errfh, '-|', './crypto-keygen-standalone -P "$SECRET" -j "$REQUESTFILE" -o "$RESPONSEFILE" 2>&1'
 162                         or die "cannot start crypto-keygen-standalone";
 163                 my $err = <$errfh>;
 164                 close $errfh
 165                         or die "crypto-keygen-standalone failed: $err";
 166                 1;
 167         }
 168         or do
 169         {
 170                 $ca{$ca}->{check}->(-1);
 171                 die "$@";
 172         };
 173
 174         print "Content-type: application/octet-stream\n\n";
 175         binmode STDOUT;
 176         print for <$tempfh>;
 177 }
 178 else
 179 {
 180         print <<EOF;
 181 Content-type: text/html
 182
 183 <!doctype html>
 184 <html>
 185 <head>
 186         <title>Xonotic keygen</title>
 187 </head>
 188 <body>
 189         <h1>Xonotic keygen</h1>
 190         <form action="response.d0ir" method="post" enctype="multipart/form-data">
 191         To generate and sign a key IN GAME, follow these steps on the console:
 192         <ol>
 193                 <li>crypto_keygen $default_ca http://xonotic.org/ca/?ca=$default_ca&amp;key=</li>
 194         </ol>
 195         To generate and sign a key MANUALLY, follow these steps on a UNIX command line:
 196         <ol>
 197                 <li>./crypto-keygen-standalone -p key_$default_ca.d0pk -o key_$default_ca.d0si</li>
 198                 <li>./crypto-keygen-standalone -p key_$default_ca.d0pk -I key_$default_ca.d0si -o request.d0iq -O camouflage.d0ic
 199                 <li>Upload the request.d0iq file: <input type="file" name="key"><input type="submit"></li>
 200                 <li>Save the response.d0ir file you are getting</li>
 201                 <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>
 202                 <li>Delete request.d0iq, camouflage.d0ic, response.d0ir</li>
 203         </ol>
 204         Your key_$default_ca.d0si key is now signed.
 205         <hr>
 206         To use another CA, please enter its number here before using this page:
 207         <input type="text" name="ca" value="$default_ca" size="2">
 208 </body>
 209 </html>
 210 EOF
 211 }