File: manage.cgi

package info (click to toggle)
0ad 0.0.17-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 51,248 kB
  • ctags: 46,933
  • sloc: cpp: 223,208; ansic: 31,240; python: 16,343; perl: 4,083; sh: 1,011; makefile: 915; xml: 733; java: 621; ruby: 229; erlang: 53; sql: 40
file content (352 lines) | stat: -rwxr-xr-x 10,896 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
#!/usr/bin/perl -wT

use strict;
use warnings;

use CGI::Simple;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use Net::Amazon::EC2;
use DateTime::Format::ISO8601;
use Archive::Zip;
use MIME::Base64;
use IO::String;
use Data::Dumper;

my $root = '/var/svn/autobuild';

my %config = load_conf("$root/manage.conf");

my $cgi = new CGI::Simple;

my $user = $cgi->remote_user;
die unless $user;

my $dbh = DBI->connect("dbi:SQLite:dbname=$root/$config{database}", '', '', { RaiseError => 1 });

my $ec2 = new Net::Amazon::EC2(
    AWSAccessKeyId => $config{aws_access_key_id},
    SecretAccessKey => $config{aws_secret_access_key},
);

my @build_options = (
    { name => 'atlas', title => 'Atlas DLL' },
    { name => 'collada', title => 'Collada DLL' },
#    { name => 'glooxwrapper', title => 'Glooxwrapper DLL' }, # this requires the autobuilder to use the same VS version gloox-1.0.dll was built with
);

my $action = $cgi->url_param('action');

if (not defined $action or $action eq 'index') {
    log_action('index');
    print_index('');

} elsif ($action eq 'start') {
    die "Must be POST" unless $cgi->request_method eq 'POST';
    log_action('start');

=pod

Only one instance may run at once, and we need to prevent race conditions.
So:
* Use SQLite as a mutex, so only one CGI script can be trying to start at once
* If the last attempted start was only a few seconds ago, reject this one since
  it's probably a double-click or something
* Check the list of active machines. If it's non-empty, reject this request.
* Otherwise, start the new machine.

=cut

    $dbh->begin_work;
    die unless 1 == $dbh->do('UPDATE state SET value = ? WHERE key = ?', undef, $$, 'process_mutex');
    my ($last_start) = $dbh->selectrow_array('SELECT value FROM state WHERE key = ?', undef, 'last_start');
    my $last_start_age = time() - $last_start;
    die "Last start was only $last_start_age seconds ago - please try again later."
        if $last_start_age < 10;
    die unless 1 == $dbh->do('UPDATE state SET value = ? WHERE key = ?', undef, time(), 'last_start');

    my $instances_status = get_ec2_status_table();
    for (@$instances_status) {
        if (instance_is_autobuild($_) and $_->{instance_state} ne 'terminated') {
            die "Already got an active instance ($_->{instance_id}) - can't start another one.";
        }
    }

    # No instances are currently active, and nobody else is in this
    # instance-starting script, so it's safe to start a new one

    my $instances = start_ec2_instance();

    $dbh->commit;

    for (@$instances) {
        $dbh->do('INSERT INTO instances VALUES (?, ?)', undef, $_->{instance_id}, DateTime->now->iso8601);
    }

    print_index(generate_status_table($instances, 'Newly started instance') . '<hr>');

} elsif ($action eq 'stop') {
    die "Must be POST" unless $cgi->request_method eq 'POST';
    my $id = $cgi->url_param('instance_id');
    $id =~ /\Ai-[0-9a-f]+\z/ or die "Invalid instance_id";
    log_action('stop', $id);
    stop_ec2_instance($id);
    print_index("<strong>Stopping instance $id</strong><hr>");

} elsif ($action eq 'console') {
    my $id = $cgi->url_param('instance_id');
    $id =~ /\Ai-[0-9a-f]+\z/ or die "Invalid instance_id";
    log_action('console', $id);
    my $output = get_console_output($id);
    $output =~ s/</&lt;/g;
    print_index("<strong>Console output from $id:</strong><pre>\n$output</pre><hr>");

} elsif ($action eq 'activity') {
    my $days = int $cgi->url_param('days') || 7;
    print_activity($days);

} else {
    log_action('invalid', $action);
    die "Invalid action '$action'";
}

$dbh->disconnect;

sub instance_is_autobuild {
    my ($instance) = @_;
    return 0 if $instance->{key_name} eq 'backupserver';
    return 1;
}

sub print_index {
    my ($info) = @_;

    my $instances_status = get_ec2_status_table();
    my $got_active_instance;
    for (@$instances_status) {
        if (instance_is_autobuild($_) and $_->{instance_state} ne 'terminated') {
            $got_active_instance = $_->{instance_id} || '?';
        }
    }

    my $status = generate_status_table($instances_status, 'Current EC2 machine status');
    print <<EOF;
Pragma: no-cache
Content-Type: text/html

<!DOCTYPE html>
<title>0 A.D. autobuild manager</title>
<link rel="stylesheet" href="manage.css">
<p>Hello <i>$user</i>.</p>
<p>
 <a href="?action=index">Refresh status</a> |
 <a href="http://wfg-autobuild-logs.s3.amazonaws.com/logindex.html">View build logs</a>
</p>
<hr>
$info
$status
<p>
EOF

    if ($got_active_instance) {
        print qq{<button disabled title="Already running an instance ($got_active_instance)">Start new build</button>\n};
    } else {
        print qq{<form action="?action=start" method="post" onsubmit="return confirm('Are you sure you want to start a new build?')">\n};
        print qq{<fieldset><legend>Build options</legend>\n};
        for (@build_options) {
            print qq{<label><input type="checkbox" name="option_$_->{name}">$_->{title}</label><br>};
        }
        print qq{<button type="submit">Start new build</button>\n};
        print qq{</fieldset></form>\n};
    }
}

sub log_action {
    my ($action, $params) = @_;
    $dbh->do('INSERT INTO activity (user, ip, ua, action, params) VALUES (?, ?, ?, ?, ?)',
        undef, $user, $cgi->remote_addr, $cgi->user_agent, $action, $params);
}

sub print_activity {
    my ($days) = @_;
    print <<EOF;
Content-Type: text/html

<!DOCTYPE html>
<title>0 A.D. autobuild activity log</title>
<link rel="stylesheet" href="manage.css">
<table>
<tr><th>Date<th>User<th>IP<th>Action<th>Params<th>UA
EOF

    my $sth = $dbh->prepare("SELECT * FROM activity WHERE timestamp > datetime('now', ?) ORDER BY id DESC");
    $sth->execute("-$days day");
    while (my $row = $sth->fetchrow_hashref) {
        print '<tr>';
        print '<td>'.$cgi->escapeHTML($row->{$_}) for qw(timestamp user ip action params ua);
        print "\n";
    }

print <<EOF;
</table>
EOF

}

sub generate_status_table {
    my ($instances, $caption) = @_;
    my @columns = (
        [ reservation_id => 'Reservation ID' ],
        [ instance_id => 'Instance ID' ],
        [ instance_state => 'State' ],
        [ image_id => 'Image ID '],
        [ dns_name => 'DNS name' ],
        [ launch_time => 'Launch time' ],
        [ reason => 'Last change' ],
    );
    my $count = @$instances;
    my $status = qq{<table id="status">\n<caption>$caption &mdash; $count instances</caption>\n<tr>};
    for (@columns) { $status .= qq{<th>$_->[1]}; }
    $status .= qq{\n};

    for my $item (@$instances) {
        $status .= qq{<tr>};
        for (@columns) {
            my $key = $_->[0];
            my $val = $item->{$key} // '';
            if ($key eq 'launch_time') {
                my $t = DateTime::Format::ISO8601->parse_datetime($val);
                my $now = DateTime->now();
                my $diff = $now - $t;
                my ($days, $hours, $minutes) = $diff->in_units('days', 'hours', 'minutes');
                my $age = "$minutes minutes ago";
                $age = "$hours hours, $age" if $hours;
                $age = "$days days, $age" if $days;
                $status .= qq{<td>$val ($age)};
            } else {
                $status .= qq{<td>$val};
            }
        }
        $status .= qq{<td><a href="?action=console;instance_id=$item->{instance_id}">Console output</a>\n};
        $status .= qq{<td><form action="?action=stop;instance_id=$item->{instance_id}" method="post" onsubmit="return confirm('Are you sure you want to terminate this instance?')"><button type="submit">Terminate</button></form>\n}
            if instance_is_autobuild($item);
    }

    $status .= qq{</table>};
    return $status;
}

sub flatten_instance {
    my ($reservation, $instance) = @_;
    return {
        reservation_id => $reservation->reservation_id,
        instance_id => $instance->instance_id,
        instance_state => $instance->instance_state->name,
        image_id => $instance->image_id,
        dns_name => $instance->dns_name,
        launch_time => $instance->launch_time,
        reason => $instance->reason,
        key_name => $instance->key_name,
    };
}

sub get_ec2_status_table {
#     return [ ];
#     return [ {
#         reservation_id => 'r-12345678',
#         instance_id => 'i-12345678',
#         instance_state => 'pending',
#         image_id => 'ami-12345678',
#         dns_name => '',
#         launch_time => '2008-12-30T17:14:22.000Z',
#         reason => '',
#     } ];

    my $reservations = $ec2->describe_instances();
    my @ret = ();
    for my $reservation (@$reservations) {
        push @ret, map flatten_instance($reservation, $_), @{$reservation->instances_set};
    }
    return \@ret;
}

sub get_console_output {
    my ($instance_id) = @_;
    my $output = $ec2->get_console_output(InstanceId => $instance_id);
    return "(Last updated: ".$output->timestamp.")\n".$output->output;
}

sub start_ec2_instance {
#     return [ {
#         reservation_id => 'r-12345678',
#         instance_id => 'i-12345678',
#         instance_state => 'pending',
#         image_id => 'ami-12345678',
#         dns_name => '',
#         launch_time => '2008-12-30T17:14:22.000Z',
#         reason => '',
#     } ];

    my $user_data = create_user_data();

    my $reservation = $ec2->run_instances(
        ImageId => $config{image_id},
        MinCount => 1,
        MaxCount => 1,
        KeyName => $config{key_name},
        SecurityGroup => $config{security_group},
        UserData => encode_base64($user_data),
        InstanceType => $config{instance_type},
        'Placement.AvailabilityZone' => $config{availability_zone},
    );

    if (ref $reservation eq 'Net::Amazon::EC2::Errors') {
        die "run_instances failed:\n".(Dumper $reservation);
    }

    return [ map flatten_instance($reservation, $_), @{$reservation->instances_set} ];
}

sub create_user_data {
    my @files = qw(run.pl run.conf);

    my $zip = new Archive::Zip;
    for (@files) {
        $zip->addFile("$root/$_", "$_") or die "Failed to add $root/$_ to zip";
    }

    my %options;
    for (@build_options) {
        $options{$_->{name}} = ($cgi->param('option_'.$_->{name}) ? 1 : 0);
    }
    my $options = Dumper \%options;
    $zip->addString($options, 'options.pl') or die "Failed to add options.pl to zip";

    my $fh = new IO::String;
    if ($zip->writeToFileHandle($fh) != Archive::Zip::AZ_OK) {
        die "writeToFileHandle failed";
    }
    return ${$fh->string_ref};
}

sub stop_ec2_instance {
    my ($instance_id) = @_;

#     return;

    $ec2->terminate_instances(
        InstanceId => $instance_id,
    );
}

sub load_conf {
    my ($filename) = @_;
    open my $f, '<', $filename or die "Failed to open $filename: $!";
    my %c;
    while (<$f>) {
        if (/^(.+?): (.+)/) {
            $c{$1} = $2;
        }
    }
    return %c;
}