push.pl 5.3 KB

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