cf69bbf7bd26203435e8b9a04e24ba5d4acee240
[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 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