/[qa]/trunk/cgi-bin/fakeupstream.cgi
ViewVC logotype

Contents of /trunk/cgi-bin/fakeupstream.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3103 - (show annotations) (download)
Mon Jan 20 02:05:42 2014 UTC (3 months ago) by pabs
File size: 24024 byte(s)
Add a fake upstream for puppet modules from forge.puppetlabs.com

Patch-by: Thomas Bechtold <toabctl@debian.org>
Closes: #736072
1 #!/usr/bin/perl -w
2
3 # Copyright (C) 2012-2013 Bart Martens <bartm@knars.be>
4 #
5 # This program is free software: you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation, either version 3 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
17
18 use strict;
19 use warnings;
20 use CGI;
21 use LWP::Simple;
22 use LWP::UserAgent;
23 use JSON;
24 use File::Temp qw/ tempdir /;
25 use Dpkg::Version;
26
27 sub redefined_version_compare
28 {
29 my $left = shift;
30 my $right = shift;
31
32 $left =~ s/%7E/~/g;
33 $right =~ s/%7E/~/g;
34 return 0 if( $left =~ /_/ );
35 return 0 if( $right =~ /_/ );
36
37 return Dpkg::Version::version_compare( $left, $right );
38 }
39
40 my $q = CGI->new;
41
42 my $project_char_re = '[a-zA-Z0-9\-]';
43 my $hg_repository_re = '[a-z\.\-:/]+';
44 my $href_char_re = '[a-zA-Z0-9\-\./]';
45 my $file_char_re = '[a-zA-Z0-9\-\._]';
46 my $suffix_re = 'tgz|tbz2|txz|tar\.(?:gz|bz2|xz)|zip|jar';
47
48 sub undef2empty
49 {
50 my $value = shift;
51 return "" if( not defined $value );
52 return $value;
53 }
54
55 sub extract_suffix
56 {
57 my $input = shift;
58 $input =~ m%\.($suffix_re)$% or return "unknown.suffix";
59 return $1;
60 }
61
62 sub return_error
63 {
64 chdir( "/" ); # for removal of vcs_tempdir
65 my $message = shift;
66 print $q->header( "text/plain" );
67 print "$message\n";
68 exit 0;
69 }
70
71 sub process_request
72 {
73 my $parms_ref = shift;
74
75 return_error( "no data found for given parameter value(s)" )
76 if( not defined $parms_ref->{'webpages_urls_ref'} or not @{$parms_ref->{'webpages_urls_ref'}} );
77
78 my $result = '';
79
80 foreach my $webpage_url ( @{$parms_ref->{'webpages_urls_ref'}} )
81 {
82 my $webpage_contents = LWP::Simple::get( $webpage_url );
83 next if( not defined $webpage_contents );
84
85 if( defined $parms_ref->{'version_re'} )
86 {
87 while( $webpage_contents =~ /$parms_ref->{'version_re'}/sg )
88 {
89 my $version = $1;
90 my $download_url = $parms_ref->{'download_url_template'};
91 $download_url =~ s/###webpage###/$webpage_url/;
92 $download_url =~ s/###project###/$parms_ref->{'project'}/;
93 $download_url =~ s/###version###/$version/;
94 my $file = ( defined $parms_ref->{'project'} ? $parms_ref->{'project'} : $parms_ref->{'package'} );
95 $file .= "-$version.".extract_suffix( $download_url );
96
97 if( undef2empty( $q->param('download') ) eq $file )
98 {
99 print $q->redirect( $download_url );
100 exit 0;
101 }
102
103 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
104 }
105 }
106
107 if( defined $parms_ref->{'file_re_template'} )
108 {
109 my $file_re = $parms_ref->{'file_re_template'};
110 $file_re =~ s/###webpage###/$webpage_url/;
111
112 while( $webpage_contents =~ /$file_re/sg )
113 {
114 my $file = $1;
115
116 if( undef2empty( $q->param('download') ) eq $file )
117 {
118 my $download_url = $parms_ref->{'download_url_template'};
119 $download_url =~ s/###webpage###/$webpage_url/;
120 $download_url =~ s/###file###/$file/;
121
122 print $q->redirect( $download_url );
123 exit 0;
124 }
125
126 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
127 }
128 }
129
130 if( defined $parms_ref->{'download_url_re'} )
131 {
132 while( $webpage_contents =~ /$parms_ref->{'download_url_re'}/sg )
133 {
134 my $download_url = $1;
135
136 my $file = $download_url;
137 $file =~ s%/download$%%; # sf
138 $file =~ s%.*/%%;
139 my $file_unescaped = $file;
140 $file_unescaped =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # man URI::Escape
141
142 if( undef2empty( $q->param('download') ) eq $file_unescaped )
143 {
144 $download_url = $parms_ref->{'baseurl'}.$download_url
145 if( defined $parms_ref->{'baseurl'} and $download_url =~ m%^/% );
146 print $q->redirect( $download_url );
147 exit 0;
148 }
149
150 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file_unescaped ) );
151 }
152 }
153
154 if( defined $parms_ref->{'download_url_version_re'} )
155 {
156 while( $webpage_contents =~ /$parms_ref->{'download_url_version_re'}/sg )
157 {
158 my $download_url = $1;
159 eval '$download_url =~ '.$parms_ref->{'downloadurlmangle'} if( defined $parms_ref->{'downloadurlmangle'} );
160 my $version = $2;
161
162 my $file = "$parms_ref->{'package'}-$version.".extract_suffix( $download_url );
163
164 if( undef2empty( $q->param('download') ) eq $file )
165 {
166 print $q->redirect( $download_url );
167 exit 0;
168 }
169
170 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
171 }
172 }
173
174 if( defined $parms_ref->{'download_url_file_re'} )
175 {
176 while( $webpage_contents =~ /$parms_ref->{'download_url_file_re'}/sg )
177 {
178 my $download_url = $1;
179 eval '$download_url =~ '.$parms_ref->{'downloadurlmangle'} if( defined $parms_ref->{'downloadurlmangle'} );
180 my $file = $2;
181
182 if( undef2empty( $q->param('download') ) eq $file )
183 {
184 print $q->redirect( $download_url );
185 exit 0;
186 }
187
188 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
189 }
190 }
191
192 if( defined $parms_ref->{'download_url_file_re'} )
193 {
194 while( $webpage_contents =~ /$parms_ref->{'download_url_file_re'}/sg )
195 {
196 my $download_url = $1;
197 eval '$download_url =~ '.$parms_ref->{'downloadurlmangle'} if( defined $parms_ref->{'downloadurlmangle'} );
198 my $file = $2;
199
200 if( undef2empty( $q->param('download') ) eq $file )
201 {
202 print $q->redirect( $download_url );
203 exit 0;
204 }
205
206 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
207 }
208 }
209 }
210
211 return_error( "requested file ".$q->param('download')." not available" ) if( defined $q->param('download') );
212 return_error( "no files found for given parameter value(s)" ) if( $result eq '' );
213
214 print $q->header;
215 print $q->start_html;
216 print $q->start_ul;
217 print $result;
218 print $q->end_ul;
219 print $q->end_html;
220
221 exit 0;
222 }
223
224 # http://forge.scilab.org/index.php/p/jlatexmath/downloads/
225 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=scilab/jlatexmath
226 if( undef2empty( $q->param('upstream') ) =~ m%^scilab/($project_char_re+)$% )
227 {
228 process_request( {
229 'webpages_urls_ref' => [ "http://forge.scilab.org/index.php/p/$1/downloads/" ],
230 'file_re_template' => "<a href=\"$href_char_re+\">($file_char_re+\\.(?:$suffix_re))</a>",
231 'download_url_template' => '###webpage###get/###file###'
232 } );
233 }
234
235 # http://code.coreboot.org/p/seabios/downloads/
236 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=coreboot/seabios
237 if( undef2empty( $q->param('upstream') ) =~ m%^coreboot/($project_char_re+)$% )
238 {
239 process_request( {
240 'webpages_urls_ref' => [ "http://code.coreboot.org/p/$1/downloads/" ],
241 'file_re_template' => "<a href=\"$href_char_re+\">($file_char_re+\\.(?:$suffix_re))</a>",
242 'download_url_template' => '###webpage###get/###file###'
243 } );
244 }
245
246 # https://npmjs.org/package/tilelive
247 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=npmjs/tilelive
248 if( undef2empty( $q->param('upstream') ) =~ m%^npmjs/($project_char_re+)$% )
249 {
250 process_request( {
251 'webpages_urls_ref' => [ "http://registry.npmjs.org/$1/" ],
252 'file_re_template' => "\"###webpage###-/($file_char_re+\\.(?:$suffix_re))\"",
253 'download_url_template' => '###webpage###-/###file###'
254 } );
255 }
256
257 # https://gitorious.org/osm-c-tools/lepeeers-osmctools
258 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=gitorious/osm-c-tools/lepeeers-osmctools
259 if( undef2empty( $q->param('upstream') ) =~ m%^gitorious/($project_char_re+)/($project_char_re+)$% )
260 {
261 my $projectdir = $1;
262 my $project = $2;
263 my $url = "https://gitorious.org/$projectdir/$project/refs";
264 my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 } );
265 my $response = $ua->get( $url );
266 my $refs_page = $response->decoded_content;
267 return_error( "failed to read $url : $response->status_line" ) if( not $response->is_success );
268 my $result = '';
269 my %tags;
270 my $json_ref = JSON::decode_json( $refs_page );
271 foreach my $tag ( @{$json_ref->{"tags"}} )
272 {
273 my $version = $tag->[0];
274 my $hash = $tag->[1];
275 my $file = "$project-$version.tar.gz";
276
277 if( undef2empty( $q->param('download') ) eq $file )
278 {
279 print $q->redirect( "https://gitorious.org/$projectdir/$project/archive/$hash.tar.gz" );
280 exit 0;
281 }
282
283 $result .= $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
284 }
285
286 print $q->header;
287 print $q->start_html;
288 print $q->start_ul;
289 print $result;
290 print $q->end_ul;
291 print $q->end_html;
292 exit 0;
293 }
294
295 # http://www.ctan.org/pkg/fragmaster
296 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=ctan/fragmaster
297 if( undef2empty( $q->param('upstream') ) =~ m%^ctan/($project_char_re+)$% )
298 {
299 my $project = $1;
300
301 my $project_page = LWP::Simple::get( "http://www.ctan.org/pkg/$project" );
302 return_error( "failed to open http://www.ctan.org/pkg/$project" ) if( not defined $project_page );
303
304 return_error( "couldn't find ctan path" )
305 if( $project_page !~ m%<tr><th>CTAN path</th><th><a href="(/tex-archive/((?:[a-z\d\-]+(?:/[a-z\d\-]+)*)))">% );
306 my $part1 = $1;
307 my $part2 = $2;
308
309 process_request( {
310 'webpages_urls_ref' => [ "http://www.ctan.org/$part1" ],
311 'project' => $project,
312 'version_re' => '<tr><td>Ver(?:&shy;)?sion</td><td>\s*(\d+(?:\.\d+)*[b]?)\s*</td></tr>',
313 'download_url_template' => "http://mirrors.ctan.org/$part2.zip"
314 } );
315 }
316
317 # http://luaforge.net/projects/md5/
318 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=luaforge/md5
319 if( undef2empty( $q->param('upstream') ) =~ m%^luaforge/($project_char_re+)$% )
320 {
321 my $project_page = LWP::Simple::get( "http://luaforge.net/projects/$1/" );
322 my @webpages_urls = ();
323
324 while( defined $project_page and $project_page =~ m%<a href="(http://files\.luaforge\.net/releases/$href_char_re+)">%sg )
325 {
326 my $project_version_page = LWP::Simple::get( $1 );
327
328 while( defined $project_version_page and $project_version_page =~ m%<a href='(http://files.luaforge.net/releases/$href_char_re+)'>%sg )
329 {
330 push @webpages_urls, $1;
331 }
332 }
333
334 process_request( {
335 'webpages_urls_ref' => \@webpages_urls,
336 'download_url_re' => "<a href='(http://files.luaforge.net/releases/$href_char_re+/$file_char_re+\\.(?:$suffix_re))'>",
337 } );
338 }
339
340 # package knights :
341 # http://kde-apps.org/content/show.php/Knights?content=122046
342 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=kdeapps/122046
343 # package auralquiz :
344 # http://qt-apps.org/content/show.php?content=139127
345 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=qtapps/139127
346 # package kde-style-polyester :
347 # http://KDE-Look.org/content/show.php?content=27968
348 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=kdelook/27968/1/2
349 if( undef2empty( $q->param('upstream') ) =~ m%^(?:kde(?:look|apps)|qtapps)/(\d+)(?:/(\d+)(?:/(\d+))?)?$% )
350 {
351 my $theme_number = $1;
352 my $hit_from;
353 my $hit_to;
354 $hit_from = $2 if( defined $2 );
355 $hit_to = $3 if( defined $3 );
356
357 my $mainsite = ( $q->param('upstream') =~ m%^qtapps% ? "qt-apps.org" :
358 ( $q->param('upstream') =~ m%^kdelook% ? "KDE-Look.org" : "kde-apps.org" ) );
359 my $theme_page = LWP::Simple::get( "http://$mainsite/content/show.php/?content=$theme_number" );
360 my $count = 0;
361 my @webpages_urls = ();
362
363 while( defined $theme_page
364 and $theme_page =~ m%<a href="/content/download\.php\?(content=\d+)(?:&|&amp;)(id=\d+)(?:&|&amp;)tan=\d+(?:&|&amp;)PHPSESSID=[\da-f]+">%sg )
365 {
366 $count++;
367
368 next if( defined $hit_from and not defined $hit_to and $count != $hit_from );
369 next if( defined $hit_from and defined $hit_to and $count < $hit_from );
370 next if( defined $hit_from and defined $hit_to and $count > $hit_to );
371
372 push @webpages_urls, "http://$mainsite/content/download.php?$1&$2";
373 }
374
375 process_request( {
376 'webpages_urls_ref' => \@webpages_urls,
377 'download_url_re' => "<a href=\"((?:http:)?$href_char_re+/$file_char_re+\\.(?:$suffix_re))(?:\.mirrorlist)?(?:\\?PHPSESSID=[\\da-f]+)?\">Click here</a>",
378 'baseurl' => "http://$mainsite",
379 } );
380 }
381
382 # http://packages.qa.debian.org/m/mysql-connector-python.html
383 # http://dev.mysql.com/downloads/connector/python/
384 if( undef2empty( $q->param('upstream') ) =~ m%^mysql((?:/[a-z]+)+)$% )
385 {
386 my $dirs = $1;
387 my $firstpage = LWP::Simple::get( "http://dev.mysql.com/downloads$dirs/?current_os=src" );
388 my @webpages_urls = ();
389 while( defined $firstpage and $firstpage =~ m%<a href="(/downloads/mirror\.php\?id=\d+)">Download</a>%sg )
390 {
391 my $urlpart = $1;
392 push @webpages_urls, "http://dev.mysql.com$urlpart";
393 }
394
395 process_request( {
396 'webpages_urls_ref' => \@webpages_urls,
397 'download_url_file_re' =>
398 "<a href=\"(/get/Downloads/$href_char_re+/($file_char_re+\\.(?:$suffix_re))/from/http://[a-z]+\\.mysql\\.com/)\">No thanks",
399 'downloadurlmangle' => 's%^%http://dev.mysql.com%',
400 } );
401 }
402
403 # http://packages.qa.debian.org/t/trac-httpauth.html
404 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=trac-hacks/HttpAuthPlugin
405 if( undef2empty( $q->param('upstream') ) =~ m%^trac-hacks/($project_char_re+)$% )
406 {
407 my $project = $1;
408 my $project_lc = lc( $project );
409
410 my $page_url = "http://trac-hacks.org/svn/$project_lc";
411 my $contents = LWP::Simple::get( $page_url );
412 return_error( "failed to open $page_url" ) if( not defined $contents );
413
414 my @setup_url;
415 push @setup_url, "http://trac-hacks.org/svn/$project_lc/trunk/setup.py" if( $contents =~ s%href="trunk/"%% );
416
417 my $trac_version = undef;
418 while( $contents =~ s%href="(\d[\d\.\-a-z]*)/"%% )
419 {
420 $trac_version = $1 if( not defined $trac_version );
421 $trac_version = $1 if( redefined_version_compare( $trac_version, $1 ) < 0 );
422 }
423
424 if( defined $trac_version )
425 {
426 push @setup_url, "http://trac-hacks.org/svn/$project_lc/$trac_version/trunk/setup.py";
427 push @setup_url, "http://trac-hacks.org/svn/$project_lc/$trac_version/setup.py";
428 }
429
430 $contents = undef;
431 foreach $page_url ( @setup_url )
432 {
433 $contents = LWP::Simple::get( $page_url );
434 last if( defined $contents );
435 }
436 return_error( "failed to find setup.py on http://trac-hacks.org/svn/$project_lc" ) if( not defined $contents );
437
438 $contents =~ m%version\s*=\s*'(\d+(?:\.\d+)*)'%
439 or $contents =~ m%VERSION\s*=\s*'(\d[\d\.\-a-z]*)'% # trac-batchmodify
440 or $contents =~ m%__version__\s*=\s*'(\d[\d\.\-a-z]*)'% # trac-graphviz
441 or return_error( "failed to find version in $page_url" );
442 my $version = $1;
443 $version =~ s%-trac\d+(?:\.\d+)*$%%; # trac-batchmodify
444
445 $page_url = "http://trac-hacks.org/browser/$project_lc";
446 $contents = LWP::Simple::get( $page_url );
447 return_error( "failed to open $page_url" ) if( not defined $contents );
448 $contents =~ m%<a href="/changeset/(\d+)/$project_lc">\s*Last Change</a>% or return_error( "failed to find changeset number in $page_url" );
449 my $changeset = $1;
450
451 $version .= "+r$1";
452 my $file = "$project_lc-$version.zip";
453
454 if( undef2empty( $q->param('download') ) eq $file )
455 {
456 print $q->redirect( "http://trac-hacks.org/changeset/$changeset/$project_lc?old_path=/&filename=$project_lc&format=zip" );
457 exit 0;
458 }
459 return_error( "requested file ".$q->param('download')." not available" ) if( defined $q->param('download') );
460
461 my $file_escaped = $file;
462 $file_escaped =~ s/([\+])/sprintf("%%%02X", ord($1))/seg;
463
464 print $q->header;
465 print $q->start_html;
466 print $q->start_ul;
467 print $q->li( $q->a( { -href => $q->self_url . "&download=$file_escaped" }, $file ) );
468 print $q->end_ul;
469 print $q->end_html;
470
471 exit( 0 );
472 }
473
474 # http://code.google.com/p/ocropus/ hg clone -r ocropus-0.6 http://code.google.com/p/ocropus
475 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=vcs/hg/google/ocropus
476 if( undef2empty( $q->param('upstream') ) =~ m%^vcs/hg/((?:google|$hg_repository_re)/($project_char_re+))$% )
477 {
478 my $hg_repository = $1;
479 my $project = $2;
480
481 $hg_repository =~ s%^google/%http://code.google.com/p/%;
482
483 my $vcs_tempdir = tempdir( CLEANUP => 1 );
484 chdir( $vcs_tempdir ) or return_error( "failed to chdir to $vcs_tempdir" );
485
486 my $command = 'hg init 2> /dev/null'
487 .' && hg incoming --newest-first --limit 1 --template "{latesttag}\n" '.$hg_repository.' 2> /dev/null'
488 .' | grep -v "^comparing with "'
489 .' | head -n 1';
490 my $tag = `$command`;
491 $tag =~ s/^\s*(\S*)\s*$/$1/;
492 return_error( "no tags found for project $project" ) if( $tag eq '' );
493
494 chdir( "/" ); # for removal of vcs_tempdir
495
496 my $version = $tag;
497 $version =~ s/^$project-//;
498 $version =~ /^\d/ or return_error( "failed to extract version from tag $tag" );
499
500 my $file = "$project-$version.tgz";
501 return_error( "please try : hg clone -r $tag $hg_repository" ) if( undef2empty( $q->param('download') ) eq $file );
502 return_error( "requested file ".$q->param('download')." not available" ) if( defined $q->param('download') );
503
504 print $q->header;
505 print $q->start_html;
506 print $q->start_ul;
507 print $q->li( $q->a( { -href => $q->self_url . "&download=$file" }, $file ) );
508 print $q->end_ul;
509 print $q->end_html;
510
511 exit( 0 );
512 }
513
514 # http://code.google.com/p/squeezelite/ git ls-remote --tags http://code.google.com/p/squeezelite
515 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=vcs/git/google/squeezelite
516 if( undef2empty( $q->param('upstream') ) =~ m%^vcs/git/google/($project_char_re+)$% )
517 {
518 my $project = $1;
519 my @tags;
520
521 my $git_repository = 'http://code.google.com/p/' . $project;
522
523 my @command = (
524 '/usr/bin/git',
525 'ls-remote',
526 '--tags',
527 $git_repository,
528 );
529 open(my $git_fh, '-|', @command)
530 or return_error("Can't run git ls-remote: $!");
531 while (<$git_fh>) {
532 chomp;
533
534 # fc4b09163f72581dbefada2eb45f6dcffa6c76b6 refs/tags/v1.0
535 # 9a57a17e0c1ac801d6f7f58b39498295521938d4 refs/tags/v1.0^{}
536 next unless /^[[:xdigit:]]+\s+refs\/tags\/(.+)$/;
537 next if $1 =~ /\^\{\}$/;
538
539 push @tags, $1;
540 }
541 close($git_fh);
542
543 return_error("no tags found for project $project")
544 if (scalar(@tags) == 0);
545
546 my $result = '';
547 for my $tag (sort @tags) {
548 my $version = $tag;
549 $version =~ s/^v//;
550 $version =~ s/^$project-//;
551 $version =~ /^\d/ or return_error("failed to extract version from tag $tag");
552
553 my $file = "$project-$version.tar.gz";
554 my $download = "https://$project.googlecode.com/archive/$tag.tar.gz";
555
556 $result .= $q->li($q->a({ -href => $download }, $file)) . "\n";
557 }
558
559 print $q->header;
560 print $q->start_html;
561 print $q->start_ul;
562 print $result;
563 print $q->end_ul;
564 print $q->end_html;
565 exit 0;
566 }
567
568 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?upstream=forge.puppetlabs/puppetlabs/stdlib
569 if( undef2empty( $q->param('upstream') ) =~ m%^forge.puppetlabs/($project_char_re+)/($project_char_re+)$% )
570 {
571 my $user = $1;
572 my $project = $2;
573 my $url = "https://forgeapi.puppetlabs.com/v3/modules/$user-$project";
574 my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 } );
575 my $response = $ua->get( $url );
576 my $refs_page = $response->decoded_content;
577 return_error( "failed to read $url : $response->status_line" ) if( not $response->is_success );
578 my $json_ref = JSON::decode_json( $refs_page );
579 print $q->header;
580 print $q->start_html;
581 print $q->start_ul;
582 foreach my $release ( @{$json_ref->{"releases"}} )
583 {
584 my $basename = join "", $user, "-", $project, "-", $release->{version}, ".tar.gz";
585 print "<li>";
586 print "<a href='https://forgeapi.puppetlabs.com/v3/files/", $basename, "'>", $basename, "</a>\n";
587 print "</li>";
588 }
589 print $q->end_ul;
590 print $q->end_html;
591 exit 0;
592 }
593
594 my %upstream_info_per_package =
595 (
596 'stopwatch' =>
597 {
598 'webpage' => 'http://expect.sourceforge.net/stopwatch/',
599 'version_re' => '<h3>Version</h3>\s*This page describes stopwatch version (\d+(?:\.\d+)*)\.\s*<h3>',
600 'download_url' => 'http://expect.sourceforge.net/stopwatch/stopwatch.tar.gz',
601 },
602 'morsegen' =>
603 {
604 'webpage' => 'http://aluigi.org/mytoolz.htm',
605 'version_re' => '<a href="mytoolz/morsegen.zip" name="morsegen">Morse generator (\d+(?:\.\d+)*)</a>',
606 'download_url' => 'http://aluigi.org/mytoolz/morsegen.zip',
607 },
608 'check-postgres' =>
609 {
610 'webpage' => 'http://bucardo.org/wiki/Check_postgres',
611 'version_re' => '<p>The latest version, (\d+(?:\.\d+)*), can be downloaded here',
612 'download_url' => 'http://bucardo.org/downloads/check_postgres.tar.gz',
613 },
614 'mriconvert' =>
615 {
616 'webpage' => 'http://lcni.uoregon.edu/~jolinda/MRIConvert/',
617 'version_re' => 'The latest revision is (\d+(?:\.\d+)*), released',
618 'download_url' => 'http://lcni.uoregon.edu/~jolinda/MRIConvert/mriconvert_sources.zip',
619 },
620 'bashburn' =>
621 {
622 'webpage' => 'http://bashburn.dose.se/index.php?s=downloads',
623 'download_url_version_re' => '<a href="(http://bashburn.dose.se/index\.php\?s=file_download&amp;id=\d+)">BashBurn (\d+(?:\.\d+)*)</a>',
624 },
625 'perl-doc-html' =>
626 {
627 'webpage' => 'http://perldoc.perl.org/',
628 'version_re' => 'To find out what\'s new in Perl (\d+(?:\.\d+)*), read the',
629 'download_url' => 'http://perldoc.perl.org/perldoc-html.tar.gz',
630 },
631 'ssl-cert-check' =>
632 {
633 'webpage' => 'http://prefetch.net/code/ssl-cert-check',
634 'version_re' => 'Current Version: (\d+(?:\.\d+)*)',
635 'download_url' => 'http://prefetch.net/code/ssl-cert-check',
636 },
637 'openarena' =>
638 {
639 'webpage' => 'http://openarena.ws/download.php',
640 'download_url_version_re' => '<a href=\'(download\.php\?list\.\d+)\'>(\d+(?:\.\d+)*)</a>',
641 'downloadurlmangle' => 's%^%http://openarena.ws/%',
642 },
643 'wikipedia2text' =>
644 {
645 'webpage' => 'https://svn.256bit.org/public-svn/wikipedia2text/tags/',
646 'version_re' => '<dir name="\d+(?:\.\d+)*" href="(\d+(?:\.\d+)*)/" />',
647 'download_url' => 'https://svn.256bit.org/public-svn/wikipedia2text/tags/###version###/wikipedia2text',
648 },
649 'shogun' =>
650 {
651 'webpage' => 'http://www.shogun-toolbox.org/page/news/newslist',
652 'download_url_version_re' => '<a href="(/new/\d+/)">\s*<font size=1>SHOGUN (\d+(?:\.\d+)*)\s*</font>',
653 'downloadurlmangle' => 's%^%http://www.shogun-toolbox.org%',
654 },
655 'aboot' =>
656 {
657 'webpage' => 'http://aboot.cvs.sourceforge.net/viewvc/aboot/aboot/include/config.h?view=markup',
658 'version_re' => 'ABOOT_VERSION\s*&quot;(\d[\.\da-z_]*)&quot;',
659 'download_url' => 'http://aboot.cvs.sourceforge.net/viewvc/aboot/aboot/?view=tar',
660 },
661 'libavg' =>
662 {
663 'webpage' => 'https://www.libavg.de/site/projects/libavg/wiki/DownLoad',
664 'download_url_file_re'
665 => '<a href="(/site/attachments/download/\d+)">(libavg-(?:\d+(?:\.\d+)*)\.(?:tgz|tbz2|txz|tar\.(?:gz|bz2|xz)|zip))</a>',
666 'downloadurlmangle' => 's%^%https://www.libavg.de%',
667 },
668 'courierpassd' =>
669 {
670 'webpage' => 'http://www.arda.homeunix.net/downloads/',
671 'download_url_file_re' => '<a href="(http://www\.arda\.homeunix\.net/\?ddownload=\d+)" class="download-link" title="Download File">(courierpassd-(?:\d+(?:\.\d+)*)\.(?:tgz|tbz2|txz|tar\.(?:gz|bz2|xz)|zip))</a>',
672 },
673 'sqlite' =>
674 {
675 'webpage' => 'http://www.sqlite.org/download.html',
676 'file_re_template' => '>(sqlite-autoconf-\d[^<]*?(?:tgz|tbz2|txz|tar\.(?:gz|bz2|xz)))<',
677 'download_url' => 'http://www.sqlite.org/2013/###file###',
678 },
679 );
680
681 # http://expect.sourceforge.net/stopwatch/
682 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?package=stopwatch
683 # http://bashburn.dose.se/index.php?s=downloads
684 # http://qa.debian.org/cgi-bin/fakeupstream.cgi?package=bashburn
685 if( defined $q->param('package') and defined $upstream_info_per_package{$q->param('package')} )
686 {
687 process_request( {
688 'webpages_urls_ref' => [ $upstream_info_per_package{$q->param('package')}{"webpage"} ],
689 'package' => $q->param('package'),
690 'version_re' => $upstream_info_per_package{$q->param('package')}{"version_re"},
691 'file_re_template' => $upstream_info_per_package{$q->param('package')}{"file_re_template"},
692 'download_url_template' => $upstream_info_per_package{$q->param('package')}{"download_url"},
693 'download_url_version_re' => $upstream_info_per_package{$q->param('package')}{"download_url_version_re"},
694 'download_url_file_re' => $upstream_info_per_package{$q->param('package')}{"download_url_file_re"},
695 'downloadurlmangle' => $upstream_info_per_package{$q->param('package')}{"downloadurlmangle"},
696 } );
697 }
698
699 return_error( "no data found for given parameter value(s)" );
700

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.5