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