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 if ($counttrans > 20)
  89 {
  90     print
  91         "Status: 403 Forbidden - go away idiot\n",
  92         "Content-Type: text/plain\n\n";
  93     exit;
  94 }
  95
  96
  97
  98 my $secret = "";
  99 my $dummyname=""; # we'll select an animal name when we approve it.
 100 foreach (1..8)
 101 {
 102         # 8 random chars is enough for the dummy name
 103         $secret .= substr("0123456789abcdefghijklmnopqrstuvwxyz",int(rand(36)),1);
 104         $dummyname .= substr("0123456789abcdef",int(rand(16)),1);
 105 }
 106 foreach (9..32)
 107 {
 108         $secret .= substr("0123456789abcdef",int(rand(16)),1);
 109 }
 110
 111 my $db = DBI->connect($dsn,$dbuser,$dbpass);
 112
 113 my $statement = <<EOS;
 114
 115   insert into buildsystems
 116     (name, secret, operating_system, os_version, compiler, compiler_version,
 117      architecture, status, sys_owner, owner_email)
 118   values(?,?,?,?,?,?,?,'pending',?,?)
 119
 120 EOS
 121 ;
 122
 123 my $sth=$db->prepare($statement);
 124 my $rv=$sth->execute($dummyname,$secret,$os,$osv,$comp,$compv,
 125                           $arch,$owner,$email);
 126 my $err=$db->errstr;
 127
 128 # everything looks OK, so tell them so
 129 print "Content-type: text/html\n\n";
 130 $template->process('register-ok.tt');
 131
 132 $sth->finish;
 133 $db->disconnect;
 134
 135
 136 use Mail::Send;
 137
 138 my $msg = new Mail::Send;
 139
 140 my $me = `id -un`; chomp($me);
 141 my $host = `hostname`; chomp ($host);
 142 $host = $default_host unless ($host =~ m/[.]/ || !defined($default_host));
 143
 144 my $from_addr = "PG Build Farm <$me\@$host>";
 145 $from_addr =~ tr /\r\n//d;
 146
 147 $msg->set('From',$from_addr);
 148
 149 $msg->to(@$notifyapp);
 150 $msg->subject('New Buildfarm Application');
 151 my $fh = $msg->open;
 152 print $fh "\n\nName: $dummyname\n",
 153     "OS: $os: $osv\n",
 154     "Arch: $arch\n",
 155     "Comp: $comp: $compv\n",
 156     "Owner: $owner <$email>\n";
 157 $fh->close;
 158
 159
 160
 161
 162
 163