cgi-bin/register.pl

   1 #!/usr/bin/perl
   2
   3 =comment
   4
   5 Copyright (c) 2003-2010, Andrew Dunstan
   6
   7 See accompanying License file for license details
   8
   9 =cut
  10
  11 use strict;
  12 use DBI;
  13 use Template;
  14 use CGI;
  15 use Template;
  16 use Captcha::reCAPTCHA;
  17
  18 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $notifyapp
  19                         $captcha_pubkey $captcha_privkey $template_dir $default_host);
  20
  21 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
  22
  23 my $dsn="dbi:Pg:dbname=$dbname";
  24 $dsn .= ";host=$dbhost" if $dbhost;
  25 $dsn .= ";port=$dbport" if $dbport;
  26
  27 my $template_opts = { INCLUDE_PATH => $template_dir};
  28 my $template = new Template($template_opts);
  29 my $query = new CGI;
  30
  31 my $params = $query->Vars;
  32
  33 my ($os, $osv, $comp, $compv, $arch, $email, $owner, $challenge, $response ) =
  34   @{$params}{
  35         qw(os osv comp compv arch email owner recaptcha_challenge_field
  36            recaptcha_response_field)};
  37
  38 my $captcha = Captcha::reCAPTCHA->new;
  39 my $captcha_ok = $captcha->check_answer
  40     (
  41      $captcha_privkey,
  42      $ENV{'REMOTE_ADDR'},
  43      $challenge, $response
  44      );
  45
  46
  47 unless ($os && $osv && $comp && $compv && $arch && $email && $owner &&
  48                 $captcha_ok->{is_valid})
  49 {
  50     print "Content-Type: text/html\n\n";
  51     $template->process('register-incomplete.tt');
  52     exit;
  53 }
  54
  55 # these filters  should catch and dispose of idiots,
  56 # although I hope they are redundant now we're using captchas.
  57
  58 if ((grep
  59    {/\@pgbuildfarm\.org|Content-Type:|http:|mailto:|href=|None|Unknown/}
  60          $os,$osv,$comp,$compv,$arch,$email,$owner))
  61 {
  62     print
  63         "Status: 403 Forbidden - go away idiot\n",
  64         "Content-Type: text/plain\n\n";
  65     exit;
  66 }
  67
  68 # count transitions to and from upper case
  69 my $trans = 1;
  70 my $counttrans = 0;
  71 foreach (split "" ,"$os$osv$comp$compv$arch$owner")
  72 {
  73         if (/[A-Z]/)
  74         {
  75                 next if $trans;
  76                 $trans = 1;
  77                 $counttrans++;
  78         }
  79         else
  80         {
  81                 next unless $trans;
  82                 $trans = 0;
  83                 $counttrans++;
  84         }
  85 }
  86
  87 # reject junk with too many transitions into/outof upper case
  88
  89 =comment
  90
  91 # disable this check now, probably redundant with captchas
  92 # and we just got a false positive
  93
  94 if ($counttrans > 20)
  95 {
  96     print
  97         "Status: 403 Forbidden - go away idiot\n",
  98         "Content-Type: text/plain\n\n";
  99     exit;
 100 }
 101
 102 =cut
 103
 104
 105 my $secret = "";
 106 my $dummyname=""; # we'll select an animal name when we approve it.
 107 foreach (1..8)
 108 {
 109         # 8 random chars is enough for the dummy name
 110         $secret .= substr("0123456789abcdefghijklmnopqrstuvwxyz",int(rand(36)),1);
 111         $dummyname .= substr("0123456789abcdef",int(rand(16)),1);
 112 }
 113 foreach (9..32)
 114 {
 115         $secret .= substr("0123456789abcdef",int(rand(16)),1);
 116 }
 117
 118 my $db = DBI->connect($dsn,$dbuser,$dbpass);
 119
 120 my $statement = <<EOS;
 121
 122   insert into buildsystems
 123     (name, secret, operating_system, os_version, compiler, compiler_version,
 124      architecture, status, sys_owner, owner_email)
 125   values(?,?,?,?,?,?,?,'pending',?,?)
 126
 127 EOS
 128 ;
 129
 130 my $sth=$db->prepare($statement);
 131 my $rv=$sth->execute($dummyname,$secret,$os,$osv,$comp,$compv,
 132                           $arch,$owner,$email);
 133 my $err=$db->errstr;
 134
 135 # everything looks OK, so tell them so
 136 print "Content-type: text/html\n\n";
 137 $template->process('register-ok.tt');
 138
 139 $sth->finish;
 140 $db->disconnect;
 141
 142
 143 use Mail::Send;
 144
 145 my $msg = new Mail::Send;
 146
 147 my $me = `id -un`; chomp($me);
 148 my $host = `hostname`; chomp ($host);
 149 $host = $default_host unless ($host =~ m/[.]/ || !defined($default_host));
 150
 151 my $from_addr = "PG Build Farm <$me\@$host>";
 152 $from_addr =~ tr /\r\n//d;
 153
 154 $msg->set('From',$from_addr);
 155
 156 $msg->to(@$notifyapp);
 157 $msg->subject('New Buildfarm Application');
 158 my $fh = $msg->open;
 159 print $fh "\n\nName: $dummyname\n",
 160     "OS: $os: $osv\n",
 161     "Arch: $arch\n",
 162     "Comp: $comp: $compv\n",
 163     "Owner: $owner <$email>\n";
 164 $fh->close;
 165
 166
 167
 168
 169
 170