13 # |
13 # |
14 # Description: |
14 # Description: |
15 # Perl script to clone or update all of the Foundation MCL repositories |
15 # Perl script to clone or update all of the Foundation MCL repositories |
16 |
16 |
17 use strict; |
17 use strict; |
|
18 use Getopt::Long; |
|
19 |
|
20 sub Usage($) |
|
21 { |
|
22 my ($msg) = @_; |
|
23 |
|
24 print "$msg\n\n" if ($msg ne ""); |
|
25 |
|
26 print <<'EOF'; |
|
27 clone_all_repositories - simple script for cloning Symbian repository tree |
|
28 |
|
29 This script will clone repositories, or pull changes into a previously |
|
30 cloned repository. The script will prompt for your username and |
|
31 password, which will be needed to access the SFL repositories, or you can |
|
32 supply them with command line arguments. |
|
33 |
|
34 Important: |
|
35 This script uses https access to the repositories, so the username and |
|
36 password will be stored as cleartext in the .hg/hgrc file for each repository. |
|
37 |
|
38 Used with the "-mirror" option, the script will copy both MCL and FCL |
|
39 repositories into the same directory layout as the Symbian website, and will |
|
40 use the Mercurial "--noupdate" option when cloning. |
|
41 |
|
42 Options: |
|
43 |
|
44 -username username at the Symbian website |
|
45 -password password to go with username |
|
46 -mirror create a "mirror" of the Symbian repository tree |
|
47 -retries number of times to retry a failed operation (default 1) |
|
48 -verbose print the underlying "hg" commands before executing them |
|
49 -n do nothing - don't actually execute the hg commands |
|
50 -help print this help information |
|
51 |
|
52 EOF |
|
53 exit (1); |
|
54 } |
18 |
55 |
19 my @clone_options = (); # use ("--noupdate") to clone without extracting the source |
56 my @clone_options = (); # use ("--noupdate") to clone without extracting the source |
20 my @pull_options = (); # use ("--rebase") to rebase your changes when pulling |
57 my @pull_options = (); # use ("--rebase") to rebase your changes when pulling |
21 my $hostname = "developer.symbian.org"; |
58 my $hostname = "developer.symbian.org"; |
|
59 |
|
60 my $username = ""; |
|
61 my $password = ""; |
22 my $mirror = 0; # set to 1 if you want to mirror the repository structure |
62 my $mirror = 0; # set to 1 if you want to mirror the repository structure |
23 my $retries = 1; # number of times to retry problem repos |
63 my $retries = 1; # number of times to retry problem repos |
|
64 my $verbose = 0; # turn on more tracing |
|
65 my $do_nothing = 0; # print the hg commands, don't actually do them |
|
66 my $help = 0; |
|
67 |
|
68 if (!GetOptions( |
|
69 "u|username" => \$username, |
|
70 "p|password" => \$password, |
|
71 "m|mirror" => \$mirror, |
|
72 "r|retries=i" => \$retries, |
|
73 "v|verbose" => \$verbose, |
|
74 "n" => \$do_nothing, |
|
75 "h|help" => \$help, |
|
76 )) |
|
77 { |
|
78 Usage("Invalid argument"); |
|
79 } |
|
80 |
|
81 Usage("Too many arguments") if ($ARGV); |
|
82 Usage("") if ($help); |
24 |
83 |
25 # Important: This script uses http access to the repositories, so |
84 # Important: This script uses http access to the repositories, so |
26 # the username and password will be stored as cleartext in the |
85 # the username and password will be stored as cleartext in the |
27 # .hg/hgrc file in each repository. |
86 # .hg/hgrc file in each repository. |
28 |
87 |
29 my $username = ""; |
88 if ($username eq "" ) |
30 my $password = ""; |
|
31 |
|
32 if ($username eq "" || $password eq "") |
|
33 { |
89 { |
34 print "Username: "; |
90 print "Username: "; |
35 $username = <STDIN>; |
91 $username = <STDIN>; |
|
92 chomp $username; |
|
93 } |
|
94 if ($password eq "" ) |
|
95 { |
36 print "Password: "; |
96 print "Password: "; |
37 $password = <STDIN>; |
97 $password = <STDIN>; |
38 chomp $username; |
|
39 chomp $password; |
98 chomp $password; |
40 } |
99 } |
41 |
100 |
42 my @sf_packages = ( |
101 my @sf_packages = ( |
43 "sfl/MCL/sf/adaptation/stubs", |
102 "sfl/MCL/sf/adaptation/stubs", |
250 if (-d "$path/.hg") |
322 if (-d "$path/.hg") |
251 { |
323 { |
252 # The repository already exists, so just do an update |
324 # The repository already exists, so just do an update |
253 |
325 |
254 print "Updating $destdir from $package...\n"; |
326 print "Updating $destdir from $package...\n"; |
255 return system("hg", "pull", @pull_options, "-R", $path, $repo_url); |
327 return do_system("hg", "pull", @pull_options, "-R", $path, $repo_url); |
256 } |
328 } |
257 else |
329 else |
258 { |
330 { |
259 # Clone the repository |
331 # Clone the repository |
260 |
332 |
261 print "Cloning $destdir from $package...\n"; |
333 print "Cloning $destdir from $package...\n"; |
262 return system("hg", "clone", @clone_options, $repo_url, $path); |
334 return do_system("hg", "clone", @clone_options, $repo_url, $path); |
263 } |
335 } |
264 |
336 |
265 } |
337 } |
266 |
338 |
267 my @all_packages; |
339 my @all_packages; |
269 @all_packages = (@sf_packages, @sftools_packages, @other_repos); |
341 @all_packages = (@sf_packages, @sftools_packages, @other_repos); |
270 |
342 |
271 if ($mirror) |
343 if ($mirror) |
272 { |
344 { |
273 push @clone_options, "--noupdate"; |
345 push @clone_options, "--noupdate"; |
|
346 |
|
347 if (0) |
|
348 { |
|
349 # Prototype code to scrape the repository list from the website |
|
350 # Needs to have extra modules and executables installed to support https |
|
351 # so this would only work for the oss packages at present... |
|
352 |
|
353 # Create a user agent object |
|
354 use LWP::UserAgent; |
|
355 use HTTP::Request::Common; |
|
356 my $ua = LWP::UserAgent->new; |
|
357 $ua->agent("clone_all_packages.pl "); |
|
358 |
|
359 # Request the oss package list |
|
360 my $res = $ua->request(GET "http://$hostname/oss"); |
|
361 |
|
362 # Check the outcome of the response |
|
363 if (! $res->is_success) |
|
364 { |
|
365 print "Failed to read oss package list:\n\t", $res->status_line, "\n"; |
|
366 } |
|
367 |
|
368 my @oss_packages = ($res->content =~ m/<td><a href="\/(oss\/[^"]+)\/?">/g); # umatched " |
|
369 print join ("\n\t",@oss_packages), "\n"; |
|
370 |
|
371 # Request the oss package list |
|
372 $res = $ua->request(GET "https://$username:$password\@$hostname/sfl"); |
|
373 |
|
374 # Check the outcome of the response |
|
375 if (! $res->is_success) |
|
376 { |
|
377 print "Failed to read sfl package list:\n\t", $res->status_line, "\n"; |
|
378 } |
|
379 |
|
380 my @sfl_packages = ($res->content =~ m/<td><a href="\/(sfl\/[^"]+)\/?">/g); # umatched " |
|
381 |
|
382 @all_packages = (@sfl_packages, @oss_packages); |
|
383 } |
|
384 else |
|
385 { |
|
386 # Assume that every MCL has a matching FCL |
|
387 my @list_with_fcls = (); |
|
388 foreach my $package (@all_packages) |
|
389 { |
|
390 push @list_with_fcls, $package; |
|
391 if ($package =~ /MCL/) |
|
392 { |
|
393 # If mirroring, get the matching FCLs as well as MCLs |
|
394 $package =~ s/MCL/FCL/; |
|
395 push @list_with_fcls, $package; |
|
396 } |
|
397 } |
|
398 @all_packages = @list_with_fcls; |
|
399 } |
|
400 |
274 } |
401 } |
275 |
402 |
276 my @problem_packages = (); |
403 my @problem_packages = (); |
277 my $total_packages = 0; |
404 my $total_packages = 0; |
278 |
405 |
279 foreach my $package (@all_packages) |
406 foreach my $package (@all_packages) |
280 { |
407 { |
281 my $err = get_repo($package); |
408 my $err = get_repo($package); |
282 $total_packages++; |
409 $total_packages++; |
283 push @problem_packages, $package if ($err); |
410 push @problem_packages, $package if ($err); |
284 |
|
285 if ($mirror && $package =~ /MCL/) |
|
286 { |
|
287 # If mirroring, get the matching FCLs as well as MCLs |
|
288 $package =~ s/MCL/FCL/; |
|
289 $err = get_repo($package); |
|
290 $total_packages++; |
|
291 push @problem_packages, $package if ($err); |
|
292 } |
|
293 } |
411 } |
294 |
412 |
295 # retry problem packages |
413 # retry problem packages |
296 |
414 |
297 while ($retries > 0 && scalar @problem_packages) |
415 my $attempt = 0; |
298 { |
416 while ($attempt < $retries && scalar @problem_packages) |
299 $retries --; |
417 { |
|
418 $attempt++; |
|
419 printf "\n\n------------\nRetry attempt %d on %d packages\n", |
|
420 $attempt, scalar @problem_packages; |
|
421 print join("\n", @problem_packages, ""), "\n"; |
|
422 |
300 my @list = @problem_packages; |
423 my @list = @problem_packages; |
301 @problem_packages = (); |
424 @problem_packages = (); |
302 foreach my $package (@list) |
425 foreach my $package (@list) |
303 { |
426 { |
304 my $err = get_repo($package); |
427 my $err = get_repo($package); |