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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.5