]>
Commit | Line | Data |
---|---|---|
9f02ff25 MG |
1 | package Gruntmaster::Handlers; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | our $VERSION = '0.001'; | |
7 | ||
9f02ff25 | 8 | use Apache2::Access; |
b746d002 | 9 | use Apache2::Authen::Passphrase qw/pwcheck pwset USER_REGEX/; |
9f02ff25 MG |
10 | use Apache2::AuthzCaps qw/hascaps/; |
11 | use Apache2::RequestRec; | |
12 | use Apache2::RequestIO; | |
13 | use Apache2::Request; | |
14 | use Apache2::Const qw/OK DECLINED/; | |
15 | use Apache2::Log; | |
16 | use Apache2::Upload; | |
17 | ||
18 | use Cwd qw/cwd/; | |
19 | use File::Basename qw/fileparse/; | |
20 | use File::Temp qw/tempdir/; | |
21 | use File::Copy qw/move/; | |
b746d002 | 22 | use Gruntmaster::Data qw/contest_start contest_end push_job set_job_inmeta insert_user PUBLISH/; |
f0ae016e MG |
23 | |
24 | use 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 |
35 | sub 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 |
43 | sub 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 |
85 | sub 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 | ||
104 | sub 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 | ||
5855b3bd MG |
117 | =begin comment |
118 | ||
9f02ff25 MG |
119 | sub private{ |
120 | my $r = shift; | |
121 | my $dir = (fileparse $r->uri)[1]; | |
122 | my $user = $r->user; | |
123 | chdir $r->dir_config('root') . $dir; | |
124 | ||
125 | for my $requirement (map { $_->{requirement} } @{$r->requires}) { | |
126 | my ($command, @args) = split ' ', $requirement; | |
127 | ||
128 | given ($command){ | |
129 | when('admin-if-private'){ | |
130 | my $meta = LoadFile 'meta.yml'; | |
131 | return OK if !$meta->{private} || ($r->user && hascaps $r->user, 'gmadm') | |
132 | } | |
133 | ||
134 | } | |
135 | } | |
136 | ||
137 | DECLINED | |
138 | } | |
139 | ||
5855b3bd MG |
140 | =end comment |
141 | ||
142 | =cut | |
143 | ||
9f02ff25 MG |
144 | 1; |
145 | __END__ | |
146 | # Below is stub documentation for your module. You'd better edit it! | |
147 | ||
148 | =head1 NAME | |
149 | ||
150 | Gruntmaster::Handlers - Perl extension for blah blah blah | |
151 | ||
152 | =head1 SYNOPSIS | |
153 | ||
154 | use Gruntmaster::Handlers; | |
155 | blah blah blah | |
156 | ||
157 | =head1 DESCRIPTION | |
158 | ||
159 | Stub documentation for Gruntmaster::Handlers, created by h2xs. It looks like the | |
160 | author of the extension was negligent enough to leave the stub | |
161 | unedited. | |
162 | ||
163 | Blah blah blah. | |
164 | ||
165 | ||
166 | =head1 SEE ALSO | |
167 | ||
168 | Mention other useful documentation such as the documentation of | |
169 | related modules or operating system documentation (such as man pages | |
170 | in UNIX), or any relevant external documentation such as RFCs or | |
171 | standards. | |
172 | ||
173 | If you have a mailing list set up for your module, mention it here. | |
174 | ||
175 | If you have a web site set up for your module, mention it here. | |
176 | ||
177 | =head1 AUTHOR | |
178 | ||
179 | Marius Gavrilescu, E<lt>marius@E<gt> | |
180 | ||
181 | =head1 COPYRIGHT AND LICENSE | |
182 | ||
183 | Copyright (C) 2013 by Marius Gavrilescu | |
184 | ||
185 | This library is free software; you can redistribute it and/or modify | |
186 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
187 | at your option, any later version of Perl 5 you may have available. | |
188 | ||
189 | ||
190 | =cut |