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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3241 - (show annotations) (download)
Sat Aug 2 13:52:36 2014 UTC (2 months, 3 weeks ago) by stuart
File size: 26164 byte(s)
Fix CTAN parsing (patch from gregor herrmann)

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.5