New server, FileBin instead of $ENV{BFConfDir}, and custom Captcha
[buildfarm-server.git] / 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;