Add problem_mark_open handler
[gruntmaster-handlers.git] / lib / Gruntmaster / Handlers.pm
CommitLineData
9f02ff25
MG
1package Gruntmaster::Handlers;
2
3use 5.014000;
4use strict;
5use warnings;
6our $VERSION = '0.001';
7
9f02ff25 8use Apache2::Access;
b746d002 9use Apache2::Authen::Passphrase qw/pwcheck pwset USER_REGEX/;
9f02ff25
MG
10use Apache2::AuthzCaps qw/hascaps/;
11use Apache2::RequestRec;
12use Apache2::RequestIO;
13use Apache2::Request;
14use Apache2::Const qw/OK DECLINED/;
15use Apache2::Log;
16use Apache2::Upload;
17
18use Cwd qw/cwd/;
19use File::Basename qw/fileparse/;
20use File::Temp qw/tempdir/;
21use File::Copy qw/move/;
92065ce4 22use Gruntmaster::Data;
f0ae016e
MG
23
24use constant FORMAT_EXTENSION => {
25 C => 'c',
26 CPP => 'cpp',
27 MONO => 'cs',
28 JAVA => 'java',
29 PASCAL => 'pas',
30 PERL => 'pl',
31 PYTHON => 'py',
32 RUBY => 'rb',
33};
9f02ff25 34
b746d002
MG
35sub aputs{
36 my ($r, $str) = @_;
37 $r->set_content_length(length $str);
38 $r->puts($str);
39 $r->content_type('text/plain');
40 OK
41}
42
9f02ff25
MG
43sub submit{
44 my $r = shift;
9f02ff25 45 my $req = Apache2::Request->new($r);
69ae93bf
MG
46 my ($problem, $format, $contest, $private, $prog) = map {scalar $req->param($_)} 'problem', 'prog_format', 'contest', 'private', 'source_code';
47 my $upload = $req->upload('prog');
48 if (defined $upload) {
49 my $temp;
50 $upload->slurp($temp);
51 $prog = $temp if $temp
52 }
5855b3bd
MG
53 die if defined $contest && $contest !~ /^\w+$/ ;
54 die if defined $contest && (time < contest_start $contest || time > contest_end $contest);
2fdef0a7
MG
55 return aputs 'A required parameter was not supplied' if grep { !defined } $problem, $format, $prog;
56
57 local $Gruntmaster::Data::contest = $contest;
5855b3bd
MG
58
59 my $job = push_job (
60 date => time,
61 problem => $problem,
62 user => $r->user,
63 defined $private ? (private => $private) : (),
64 defined $contest ? (contest => $contest, private => 1) : (),
65 filesize => length $prog,
f0ae016e 66 extension => FORMAT_EXTENSION->{$format},
5855b3bd
MG
67 );
68
69 set_job_inmeta $job, {
70 files => {
71 prog => {
72 format => $format,
f0ae016e 73 name => 'prog.' . FORMAT_EXTENSION->{$format},
5855b3bd
MG
74 content => $prog,
75 }
9f02ff25 76 }
9f02ff25
MG
77 };
78
2fdef0a7
MG
79 $contest //= '';
80 PUBLISH 'jobs', "$contest.$job";
9f02ff25
MG
81 $r->print("Job submitted");
82 OK
83}
84
b746d002
MG
85sub register{
86 my $r = shift;
87 my $req = Apache2::Request->new($r);
f1df5335 88 my ($username, $password, $confirm_password, $name, $email, $phone, $town, $university, $level) = map { die if length > 200; $_ } map {scalar $req->param($_)} qw/username password confirm_password name email phone town university level/;
b746d002
MG
89
90 local $Apache2::Authen::Passphrase::rootdir = $r->dir_config('AuthenPassphraseRootdir');
91 return aputs $r, 'Bad username. Allowed characters are letters, digits and underscores, and the username must be between 2 and 20 characters long.' unless $username =~ USER_REGEX;
92 return aputs $r, 'Username already in use' if -e "$Apache2::Authen::Passphrase::rootdir/$username.yml";
93 return aputs $r, 'The two passwords do not match' unless $password eq $confirm_password;
f1df5335 94 return aputs $r, 'All fields are required' if grep { !length } $username, $password, $confirm_password, $name, $email, $phone, $town, $university, $level;
b746d002
MG
95 pwset $username, $password;
96
f1df5335 97 insert_user $username, name => $name, email => $email, phone => $phone, town => $town, university => $university, level => $level;
b746d002 98
35504454
MG
99 PUBLISH genpage => "us/index.html";
100 PUBLISH genpage => "us/$username.html";
b746d002
MG
101 aputs $r, 'Registered successfully';
102}
103
104sub passwd{
105 my $r = shift;
106 my $req = Apache2::Request->new($r);
107 my ($oldpass, $newpass, $confirm) = map {scalar $req->param($_)} 'password', 'new_password', 'confirm_new_password';
108
109 local $Apache2::Authen::Passphrase::rootdir = $r->dir_config('AuthenPassphraseRootdir');
110 return aputs $r, 'Incorrect password' unless eval { pwcheck $r->user, $oldpass; 1 };
111 return aputs $r, 'The two passwords do not match' unless $newpass eq $confirm;
112
113 pwset $r->user, $newpass;
114 aputs $r, 'Password changed successfully';
115}
116
92065ce4
MG
117sub problem_mark_open{
118 my $r = shift;
119 $r->uri =~ m,/ct/([^/]*)/pb/([^.]*),;
120 $r->log_error("Marking open for contest $1 problem $2 and user " . $r->user);
121 local $Gruntmaster::Data::contest = $1;
122 my $problem = $2;
123 mark_open $problem, $r->user;
124}
125
5855b3bd
MG
126=begin comment
127
9f02ff25
MG
128sub private{
129 my $r = shift;
130 my $dir = (fileparse $r->uri)[1];
131 my $user = $r->user;
132 chdir $r->dir_config('root') . $dir;
133
134 for my $requirement (map { $_->{requirement} } @{$r->requires}) {
135 my ($command, @args) = split ' ', $requirement;
136
137 given ($command){
138 when('admin-if-private'){
139 my $meta = LoadFile 'meta.yml';
140 return OK if !$meta->{private} || ($r->user && hascaps $r->user, 'gmadm')
141 }
142
143 }
144 }
145
146 DECLINED
147}
148
5855b3bd
MG
149=end comment
150
151=cut
152
9f02ff25
MG
1531;
154__END__
155# Below is stub documentation for your module. You'd better edit it!
156
157=head1 NAME
158
159Gruntmaster::Handlers - Perl extension for blah blah blah
160
161=head1 SYNOPSIS
162
163 use Gruntmaster::Handlers;
164 blah blah blah
165
166=head1 DESCRIPTION
167
168Stub documentation for Gruntmaster::Handlers, created by h2xs. It looks like the
169author of the extension was negligent enough to leave the stub
170unedited.
171
172Blah blah blah.
173
174
175=head1 SEE ALSO
176
177Mention other useful documentation such as the documentation of
178related modules or operating system documentation (such as man pages
179in UNIX), or any relevant external documentation such as RFCs or
180standards.
181
182If you have a mailing list set up for your module, mention it here.
183
184If you have a web site set up for your module, mention it here.
185
186=head1 AUTHOR
187
188Marius Gavrilescu, E<lt>marius@E<gt>
189
190=head1 COPYRIGHT AND LICENSE
191
192Copyright (C) 2013 by Marius Gavrilescu
193
194This library is free software; you can redistribute it and/or modify
195it under the same terms as Perl itself, either Perl version 5.18.1 or,
196at your option, any later version of Perl 5 you may have available.
197
198
199=cut
This page took 0.022959 seconds and 4 git commands to generate.