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