push.pl 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use 5.010;
  5. use open ':encoding(utf8)';
  6. use File::Temp;
  7. use Getopt::Long;
  8. use Mojo::UserAgent;
  9. use Mojo::Util qw(decode encode slurp spurt trim);
  10. use Term::ReadKey;
  11. my $username;
  12. my $password;
  13. my $all;
  14. GetOptions(
  15. 'u|username=s' => \$username,
  16. 'p|password=s' => \$password,
  17. 'a|all' => \$all,
  18. ) or die 'bad args';
  19. die 'no repos specified' unless @ARGV;
  20. my $ua = Mojo::UserAgent->new->max_redirects(10);
  21. # Mojo::UserAgent::CookieJar::find is destructive...
  22. # this is a nondestructive version that makes the login succeed on the Hub
  23. Mojo::Util::monkey_patch 'Mojo::UserAgent::CookieJar', find => sub {
  24. my ($self, $url) = @_;
  25. return unless my $domain = my $host = $url->ihost;
  26. my $path = $url->path->to_abs_string;
  27. my @found;
  28. while ($domain =~ /[^.]+\.[^.]+|localhost$/) {
  29. next unless my $old = $self->{jar}{$domain};
  30. # Grab cookies
  31. #my $new = $self->{jar}{$domain} = [];
  32. for my $cookie (@$old) {
  33. next unless $cookie->domain || $host eq $cookie->origin;
  34. # Check if cookie has expired
  35. my $expires = $cookie->expires;
  36. next if $expires && time > ($expires || 0);
  37. #push @$new, $cookie;
  38. # Taste cookie
  39. next if $cookie->secure && $url->protocol ne 'https';
  40. next unless Mojo::UserAgent::CookieJar::_path($cookie->path, $path);
  41. my $name = $cookie->name;
  42. my $value = $cookie->value;
  43. push @found, Mojo::Cookie::Request->new(name => $name, value => $value);
  44. }
  45. }
  46. # Remove another part
  47. continue { $domain =~ s/^[^.]+\.?// }
  48. return @found;
  49. };
  50. sub get_form_bits {
  51. my $form = shift;
  52. my $ret = {};
  53. $form->find('input, textarea')->grep(sub {
  54. !$_->match('input[type=submit], input[type=reset], input[type=button]')
  55. && defined($_->attr('name'))
  56. })->each(sub {
  57. my $e = shift;
  58. my $name = $e->attr('name');
  59. my $val;
  60. if ($e->type eq 'textarea') {
  61. $val = $e->text;
  62. }
  63. else {
  64. $val = $e->attr('value');
  65. }
  66. $val = trim('' . ($val // ''));
  67. $val =~ s!\r\n|\r!\n!g;
  68. $ret->{$name} = $val;
  69. });
  70. return $ret;
  71. }
  72. my $login = $ua->get('https://registry.hub.docker.com/account/login/');
  73. die 'login failed' unless $login->success;
  74. my $loginForm = $login->res->dom('#form-login')->first;
  75. my $loginBits = get_form_bits($loginForm);
  76. unless (defined $username) {
  77. print 'Hub Username: ';
  78. $username = ReadLine 0;
  79. chomp $username;
  80. }
  81. $loginBits->{username} = $username;
  82. unless (defined $password) {
  83. print 'Hub Password: ';
  84. ReadMode 2;
  85. $password = ReadLine 0;
  86. chomp $password;
  87. ReadMode 0;
  88. print "\n";
  89. }
  90. $loginBits->{password} = $password;
  91. $login = $ua->post($login->req->url->to_abs => {
  92. Referer => $login->req->url->to_abs->to_string,
  93. } => form => $loginBits);
  94. die 'login failed' unless $login->success;
  95. my $error = $login->res->dom('.alert-error');
  96. if ($error->size) {
  97. die $error->pluck('all_text')->join("\n") . "\n";
  98. }
  99. while (my $repo = shift) { # '/_/hylang', '/u/tianon/perl', etc
  100. $repo =~ s!/+$!!;
  101. $repo = '/_/' . $repo unless $repo =~ m!/!;
  102. $repo = '/' . $repo unless $repo =~ m!^/!;
  103. my $repoName = $repo;
  104. $repoName =~ s!^.*/!!; # 'hylang', 'perl', etc
  105. my $shortFile = $repoName . '/README-short.txt';
  106. my $short = slurp $shortFile or warn 'missing ' . $shortFile;
  107. $short = trim(decode('UTF-8', $short));
  108. my $longFile = $repoName . '/README.md';
  109. my $long = slurp $longFile or warn 'missing ' . $longFile;
  110. $long = trim(decode('UTF-8', $long));
  111. my $repoUrl = 'https://registry.hub.docker.com' . $repo . '/settings/';
  112. my $repoTx = $ua->get($repoUrl);
  113. die 'failed to get: ' . $repoUrl unless $repoTx->success;
  114. my $settingsForm = $repoTx->res->dom('form[name="repository_settings"]')->first;
  115. die 'failed to find form on ' . $repoUrl unless $settingsForm;
  116. my $settingsBits = get_form_bits($settingsForm);
  117. my $hubShort = $settingsBits->{description};
  118. my $hubLong = $settingsBits->{full_description};
  119. if ($hubShort ne $short) {
  120. my $file = File::Temp->new(SUFFIX => '.txt');
  121. my $filename = $file->filename;
  122. spurt encode('UTF-8', $hubShort . "\n"), $filename;
  123. system('vimdiff', $filename, $shortFile) == 0 or die "vimdiff on $filename and $shortFile failed";
  124. $hubShort = trim(decode('UTF-8', slurp($filename)));
  125. }
  126. if ($hubLong ne $long) {
  127. my $file = File::Temp->new(SUFFIX => '.md');
  128. my $filename = $file->filename;
  129. spurt encode('UTF-8', $hubLong . "\n"), $filename;
  130. system('vimdiff', $filename, $longFile) == 0 or die "vimdiff on $filename and $longFile failed";
  131. $hubLong = trim(decode('UTF-8', slurp($filename)));
  132. }
  133. say 'no change to ' . $repoName . '; skipping' and next if $settingsBits->{description} eq $hubShort and $settingsBits->{full_description} eq $hubLong;
  134. $settingsBits->{description} = $hubShort;
  135. $settingsBits->{full_description} = $hubLong;
  136. $repoTx = $ua->post($repoUrl => { Referer => $repoUrl } => form => $settingsBits);
  137. die 'post to ' . $repoUrl . ' failed' unless $repoTx->success;
  138. my $alert = $repoTx->res->dom('.alert-error');
  139. if ($alert->size) {
  140. my $text = trim $alert->pluck('all_text');
  141. die 'update to ' . $repoUrl . ' failed:' . "\n" . $text if $text;
  142. }
  143. }