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
  17 use vars qw($dbhost $dbname $dbuser $dbpass $dbport $notifyapp
  18                         $template_dir $default_host);
  19
  20 use FindBin qw($RealBin);
  21 require "$RealBin/../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, $arg1, $arg2, $argop, $res ) =
  34   @{$params}{qw(os osv comp compv arch email owner arg1 arg2 op res)};
  35
  36 $argop = '-' if !$argop or $argop ne '+';
  37 $arg1 = int($arg1 || 0);
  38 $arg2 = int($arg2 || 0);
  39 $res = int($res || 0);
  40 my $captcha_ok = ($arg1 and $argop and $arg2 and $res
  41                   and int(eval "$arg1 $argop $arg2") == $res) ? 1 : 0;
  42
  43 unless ($os && $osv && $comp && $compv && $arch && $email && $owner &&
  44                 $captcha_ok)
  45 {
  46     print "Content-Type: text/html\n\n";
  47     $template->process('register-incomplete.tt');
  48     exit;
  49 }
  50
  51 # these filters  should catch and dispose of idiots,
  52 # although I hope they are redundant now we're using captchas.
  53
  54 if ((grep
  55    {/\@pgbuildfarm\.org|Content-Type:|http:|mailto:|href=|None|Unknown/}
  56          $os,$osv,$comp,$compv,$arch,$email,$owner))
  57 {
  58     print
  59         "Status: 403 Forbidden - go away idiot\n",
  60         "Content-Type: text/plain\n\n";
  61     exit;
  62 }
  63
  64 # count transitions to and from upper case
  65 my $trans = 1;
  66 my $counttrans = 0;
  67 foreach (split "" ,"$os$osv$comp$compv$arch$owner")
  68 {
  69         if (/[A-Z]/)
  70         {
  71                 next if $trans;
  72                 $trans = 1;
  73                 $counttrans++;
  74         }
  75         else
  76         {
  77                 next unless $trans;
  78                 $trans = 0;
  79                 $counttrans++;
  80         }
  81 }
  82
  83 # reject junk with too many transitions into/outof upper case
  84
  85 =comment
  86
  87 # disable this check now, probably redundant with captchas
  88 # and we just got a false positive
  89
  90 if ($counttrans > 20)
  91 {
  92     print
  93         "Status: 403 Forbidden - go away idiot\n",
  94         "Content-Type: text/plain\n\n";
  95     exit;
  96 }
  97
  98 =cut
  99
 100
 101 my $secret = "";
 102 my $dummyname=""; # we'll select an animal name when we approve it.
 103 foreach (1..8)
 104 {
 105         # 8 random chars is enough for the dummy name
 106         $secret .= substr("0123456789abcdefghijklmnopqrstuvwxyz",int(rand(36)),1);
 107         $dummyname .= substr("0123456789abcdef",int(rand(16)),1);
 108 }
 109 foreach (9..32)
 110 {
 111         $secret .= substr("0123456789abcdef",int(rand(16)),1);
 112 }
 113
 114 my $db = DBI->connect($dsn,$dbuser,$dbpass);
 115
 116 my $statement = <<EOS;
 117
 118   insert into buildsystems
 119     (name, secret, operating_system, os_version, compiler, compiler_version,
 120      architecture, status, sys_owner, owner_email)
 121   values(?,?,?,?,?,?,?,'pending',?,?)
 122
 123 EOS
 124 ;
 125
 126 my $sth=$db->prepare($statement);
 127 my $rv=$sth->execute($dummyname,$secret,$os,$osv,$comp,$compv,
 128                           $arch,$owner,$email);
 129 my $err=$db->errstr;
 130
 131 # everything looks OK, so tell them so
 132 print "Content-type: text/html\n\n";
 133 $template->process('register-ok.tt');
 134
 135 $sth->finish;
 136 $db->disconnect;
 137
 138
 139 use Mail::Send;
 140
 141 my $msg = new Mail::Send;
 142
 143 my $me = `id -un`; chomp($me);
 144 my $host = `hostname`; chomp ($host);
 145 $host = $default_host unless ($host =~ m/[.]/ || !defined($default_host));
 146
 147 my $from_addr = "Exim Build Farm <$me\@$host>";
 148 $from_addr =~ tr /\r\n//d;
 149
 150 $msg->set('From',$from_addr);
 151
 152 $msg->to(@$notifyapp);
 153 $msg->subject('New BuildFarm Application');
 154 my $fh = $msg->open;
 155 print $fh "\n\nName: $dummyname\n",
 156     "OS: $os: $osv\n",
 157     "Arch: $arch\n",
 158     "Comp: $comp: $compv\n",
 159     "Owner: $owner <$email>\n";
 160 $fh->close;
 161
 162 use HTTP::Tiny;
 163 use JSON::PP;
 164 HTTP::Tiny->new(timeout => 5)->post(
 165     'http://127.0.0.1:2567/api/message', {
 166         headers => {'content-type' => 'application/json'},
 167         content => encode_json({
 168             gateway => 'exim-builds',
 169             username => '',
 170             text => "[new application] os: $os ($osv); arch: $arch; comp: $comp ($compv)",
 171         }),
 172     }
 173 );