#!/opt/local/bin/perl -w
# Copyright © 2022-2023 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Post an image or video to Mastodon.
#
# Requires resize.pl (https://www.jwz.org/hacks/#resize) and ffmpeg to
# adjust the image or video to the proper size and dimensions.
#
#  Expects $HOME/.USER-mastodon-pass to exist and contain secrets.
#  Create it by running this with --generate-session.
#
# Usage:
#
#   mastodon-upload.pl USER --caption "TEXT" IMAGE-OR-VIDEO-FILE
#
# Can also incrementally back up all of your posts.  Saves text and
# attachments in files of the form YYYYMMDD-HHMMSS-POSTID.EXT.
#
#   mastodon-upload.pl USER --backup DIRECTORY
#
# Created:  11-Jan-2017

require 5;
use diagnostics;
use strict;

# For resize.pl and ffmpeg.
$ENV{PATH} = "/opt/local/bin:/var/www/jwz/hacks:$ENV{PATH}";

use POSIX;
use HTML::Entities;
use LWP::UserAgent;
use JSON::Any;
use Data::Dumper;
use Date::Parse;

my $progname = $0; $progname =~ s@.*/@@g;
my ($version) = ('$Revision: 1.17 $' =~ m/\s(\d[.\d]+)\s/s);

my $verbose = 0;
my $debug_p = 0;

# Anything placed on this list gets unconditionally deleted when this
# script exits, even if abnormally.
#
my %rm_f;
END { rmf(); }

sub rmf() {
  foreach my $f (sort keys %rm_f) {
    if (-e $f) {
      print STDERR blurb() . "rm $f\n" if ($verbose > 1);
      unlink $f;
    }
  }
  %rm_f = ();
}

sub rm_atexit($) {
  my ($file) = @_;
  $rm_f{$file} = 1;
}


sub signal_cleanup($) {
  my ($s) = @_;
  print STDERR blurb() . "SIG$s\n" if ($verbose > 1);
  rmf();
  # Propagate the signal and die. This does not cause END to run.
  $SIG{$s} = 'DEFAULT';
  kill ($s, $$);
}

$SIG{TERM} = \&signal_cleanup;  # kill
$SIG{INT}  = \&signal_cleanup;  # shell ^C
$SIG{QUIT} = \&signal_cleanup;  # shell ^|
$SIG{KILL} = \&signal_cleanup;  # nope
$SIG{ABRT} = \&signal_cleanup;
$SIG{HUP}  = \&signal_cleanup;
$SIG{PIPE} = 'IGNORE';


sub blurb() {
  return  "$progname: " . strftime('%l:%M:%S %p: ', localtime);
}


sub html_quote($) {
  my ($s) = @_;
  return undef unless defined ($s);
  $s =~ s/&/&amp;/gs;
  $s =~ s/</&lt;/gs;
  $s =~ s/>/&gt;/gs;
  return $s;
}

# Convert any HTML entities to Unicode characters.
#
sub html_unquote($) {
  my ($s) = @_;
  return undef unless defined($s);
  return $s unless ($s =~ m/&/s);   # Faster?
  return HTML::Entities::decode_entities ($s);
}

sub url_quote($) {
  my ($u) = @_;
  $u =~ s|([^-a-zA-Z0-9.\@_\r\n])|sprintf("%%%02X", ord($1))|ge;
  return $u;
}

sub url_unquote($) {
  my ($url) = @_;
  $url =~ s/[+]/ /g;
  $url =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
  return $url;
}


sub load_keys($;$) {
  my ($user, $noerror) = @_;

  my $instance        = '';
  my $home_domain     = '';
  my $client          = '';
  my $client_secret   = '';
  my $access          = '';

  # Read our mastodon tokens
  error ("no \$HOME") unless defined($ENV{HOME});
  my $mastodon_pass_file = "$ENV{HOME}/.$user-mastodon-pass";
  if (open (my $in, '<', $mastodon_pass_file)) {
    print STDERR blurb() . "read $mastodon_pass_file\n" if ($verbose > 1);
    while (<$in>) { 
      s/#.*$//s;
      if (m/^\s*$/s) {
      } elsif (m/^client_id\s*=\s*(.*?)\s*$/) { 
        $client = $1;
      } elsif (m/^client_secret\s*=\s*(.*?)\s*$/) { 
        $client_secret = $1;
      } elsif (m/^access\s*=\s*(.*?)\s*$/) { 
        $access = $1;
      } elsif (m/^instance\s*=\s*(.*?)\s*$/) { 
        $instance = $1;
      } elsif (m/^home\s*=\s*(.*?)\s*$/) { 
        $home_domain = $1;
      } else {
        error ("$mastodon_pass_file: unparsable line: $_");
      }
    }
    close $in;

  } elsif ($noerror) {
    return ();
  } elsif ($debug_p) {
    print STDERR blurb() . "$mastodon_pass_file: $!\n";
  } else {
    error ("$mastodon_pass_file: $!");
  }

  return ($instance, $home_domain, $client, $client_secret, $access);
}


sub json_decode($) {
  my ($s) = @_;
  my $json = undef;
  eval {
    my $j = JSON::Any->new;
    $json = $j->jsonToObj ($s);
  };
  return $json;
}


sub generate_session($) {
  my ($user) = @_;

  my $mastodon_pass_file = "$ENV{HOME}/.$user-mastodon-pass";
  my ($instance, $home_domain,
      $client_id, $client_secret, $access) = load_keys ($user, 1);

  if (! $instance) {
    print STDOUT "Domain of the mastodon instance: ";
    $instance = <>;
    chomp ($instance);
    $instance =~ s@^https?://@@s;
    $instance =~ s@/.*$@@s;
    error ("not a domain: $instance") unless ($instance =~ m/\./s);
  }

  if (! $home_domain) {
    print STDOUT "Your personal domain name: ";
    $home_domain = <>;
    chomp ($home_domain);
    $home_domain =~ s@^https?://@@s;
    $home_domain =~ s@/.*$@@s;
    error ("not a domain: $home_domain") unless ($home_domain =~ m/\./s);
  }

  my $ua = LWP::UserAgent->new;
  $ua->agent ("$progname/$version");

  my $scopes = 'read write follow push';

  if (! $client_secret) {
    my $url = "https://$instance/api/v1/apps";
    my $res = $ua->post ($url,
                         Content_Type => 'form-data',
                         Content      => { client_name => $home_domain,
                                           redirect_uris =>
                                             'urn:ietf:wg:oauth:2.0:oob',
                                           scopes  => $scopes,
                                           website => "https://$home_domain",
                                         });
    mastodon_error ("creating app", $res)
      unless ($res->is_success);

    my $json = json_decode ($res->decoded_content);
    error ("no json") unless $json;
    $client_id     = $json->{client_id}     || error ("no client ID");
    $client_secret = $json->{client_secret} || error ("no client secret");
  }

  if (! $access) {
    my $url = "https://$instance/oauth/token";
    my $res = $ua->post ($url,
                         Content_Type => 'form-data',
                         Content      => { grant_type  => 'client_credentials',
                                           client_id     => $client_id,
                                           client_secret => $client_secret,
                                           redirect_uris =>
                                             'urn:ietf:wg:oauth:2.0:oob',
                                           scopes  => $scopes,
                                         });
    mastodon_error ("authorizing app", $res)
      unless ($res->is_success);

    my $json = json_decode ($res->decoded_content);
    error ("no json") unless $json;
    $access = $json->{access_token}  || error ("no access token");
  }

  # Now the user has to long in with a browser to get a real bearer token.
  #
  if (1) {
    my $url = ("https://$instance/oauth/authorize" .
               "?response_type=code" .
               "&client_id=$client_id" .
               "&redirect_uri=urn:ietf:wg:oauth:2.0:oob" .
               "&scope=$scopes");
    $url =~ s/ /%20/gs;
    print STDOUT "\nOpen this URL in a browser:\n\t$url\n";
    print STDOUT "\nPaste the auth code here: ";
    my $code = <>;
    chomp ($code);
    error ("no code") unless ($code);

    $url = "https://$instance/oauth/token";
    my $res = $ua->post ($url,
                         Content_Type => 'form-data',
                         Content      => { grant_type  => 'authorization_code',
                                           client_id     => $client_id,
                                           client_secret => $client_secret,
                                           redirect_uri =>
                                             'urn:ietf:wg:oauth:2.0:oob',
                                           scopes  => $scopes,
                                           code    => $code,
                                         });
    mastodon_error ("authorizing app", $res)
      unless ($res->is_success);

    my $json = json_decode ($res->decoded_content);
    error ("no json") unless $json;
    $access = $json->{access_token}  || error ("no access token");
  }

  my $body = '';
  if (open (my $in, '<', $mastodon_pass_file)) {
    local $/ = undef;  # read entire file
    $body = <$in>;
    close $in;
  }
  my $obody = $body;

  $body =~ s/^\s+//gs;
  $body =~ s/^/# /gm if ($body);
  $body =~ s/^(# )# */$1/gm;

  $body = ("instance\t= $instance\n" .
           "home\t\t= $home_domain\n" .
           "client_id\t= $client_id\n" .
           "client_secret\t= $client_secret\n" .
           "access\t\t= $access\n" .
           ($body ? "\n$body" : ""));

  error ("tokens unchanged!") if ($body eq $obody);
  open (my $out, '>', $mastodon_pass_file) ||
    error ("$mastodon_pass_file: $!");
  print $out $body;
  close $out;
  print STDOUT blurb() . "wrote $mastodon_pass_file\n";
  print STDOUT "\nOK!\n\n";
  exit (0);
}


sub mastodon_login($) {
  my ($user) = @_;

  my ($instance, $home_domain, $client, $client_secret, $access) =
    load_keys ($user);

  my $ua = LWP::UserAgent->new;
  $ua->agent ("$progname/$version");

  if ($verbose > 3) {
    $ua->add_handler("request_send",  sub { shift->dump; return });
    $ua->add_handler("response_done", sub { shift->dump; return });
  }

  return { user     => $user,
           ua       => $ua,
           instance => $instance,
           access   => $access,
         };
}


sub ext_to_ct($) {
  my ($file) = @_;
  return undef unless defined($file);
  $file =~ s@^.*/@@s;
  $file =~ s@^.*\.@@s;
  return ($file =~ m/^p?jpe?g$/si   ? 'image/jpeg' :
          $file =~ m/^gif$/si       ? 'image/gif'  :
          $file =~ m/^png$/si       ? 'image/png'  :
          $file =~ m/^mp4$/si       ? 'video/mp4'  :
          $file =~ m/^m4v$/si       ? 'video/mp4'  :
          $file =~ m/^mov$/si       ? 'video/quicktime' :
          $file =~ m/^ts$/si        ? 'video/mp2t' :
          $file =~ m/^m3u8?$/si     ? 'application/x-mpegurl' :
          $file =~ m/^([^.\/]+)$/si ? "image/$1" :
          'application/octet-stream');
}


# Like system() but respects error codes.
#
sub safe_system(@) {
  my @cmd = @_;
  print STDERR blurb() . "exec: " . join(' ', @cmd) . "\n"
    if ($verbose > 1);
  system (@cmd);
  my $exit_value  = $? >> 8;
  my $signal_num  = $? & 127;
  my $dumped_core = $? & 128;
  error ("$cmd[0]: core dumped!") if ($dumped_core);
  error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
  return $exit_value;
}


# Returns:
#  name, content-type,
#  filename (contains image or video data)
#  thumbnail-filename (contains JPEG data if it's a video)
#
sub load_photo_data($) {
  my ($file) = @_;

  my ($ct, $name, $thumb);

  my $tmp = $ENV{TMPDIR} || '/tmp';
  $tmp =~ s@/+$@@s;
  my $base = sprintf("%s/mastup-%08x", $tmp, rand(0xFFFFFFFF));

  if ($file =~ m@\.(m3u8)?$@si) {
    $ct = ext_to_ct ($file);

  } elsif ($file =~ m@^https?://@si) {
    my $url = $file;

    my $ua = LWP::UserAgent->new;
    $ua->agent("$progname/$version");
    my $res;

    $name = $url;
    $name =~ s@[?&].*$@@s;
    $name =~ s@^.*/@@s;
    $name = url_unquote ($name);
    $name =~ s/(:[a-z]+)$//s;  # ":large"
    $name =~ s/[^-_.a-z\d ]//gsi;
    $name = 'image' unless $name;

    $file = "$base-$name";
    rm_atexit ($file);
    print STDERR blurb() . "saving $url to $file\n" if ($verbose > 1);
    $res = $ua->get ($url, ':content_file' => $file);
    my $ret = ($res && $res->code) || 'null';
    error ("$url failed: $ret") unless ($ret eq '200');
    $ct = $res->header ('Content-Type') || 'application/octet-stream';
    $ct =~ s/[;\s].*$//s;

  } else {
    error ("$file does not exist") unless (-f $file);
    $ct = ext_to_ct ($file);
  }

  if (! $name) {
    $name = $file;
    $name =~ s@^.*/@@s;
  }

  $name =~ s/:(large|medium|small)$//s;    # Twitter
  $name =~ s@\.[^./]+$@@s;                 # extension
  $name =~ s/^\s+|\s+$//s;
  $name =~ s/\s+\[[-_a-z\d]{11,}\]$//gsi;  # Youtube ID

  my @cmd = ('resize.pl', '--preset', 'mastodon', '-q');
  push @cmd, '-v' if ($verbose > 1);
  #push @cmd, ('-' . ('v' x ($verbose-1))) if ($verbose > 1);
  push @cmd, $file;

  my $file2 = "$base-$name-2";
  my $ext = ($ct =~ m@^video/@si ? 'mp4' :	# Constrain MP4 video.
             $ct =~ m@^application/(x-)?mpegurl@si ? 'mp4' :	# M3U video
             $ct =~ m@gif@si ? 'gif' :  # GIFs stay GIFs, not video
             $ct =~ m@png@si ? 'png' :  # PNGs stay PNG
             'jpg');			# Convert everything else to JPEG
  $file2 .= ".$ext";
  rm_atexit ($file2);
  push @cmd, ('--out', $file2);
  safe_system (@cmd);

  $file2 = $file unless (-f $file2);  # Might have needed no changes

  if ($ext eq 'mp4') {		# Get thumbnail.
    $ct = 'video/mp4';
    $thumb = "$base-$name-3.jpg";
    rm_atexit ($thumb);
    pop @cmd;
    push @cmd, $thumb;
    safe_system (@cmd);
    error ("$name: no thumbnail file: $thumb")
      unless (-f $thumb);
  }

  return ($name, $ct, $file2, $thumb);
}


sub mastodon_error($$;$) {
  my ($prefix, $res, $noerror) = @_;

  my $json = json_decode ($res->decoded_content);
  my $err = (($prefix ? "$prefix: " : "") .
             (!$res->decoded_content
              ? ($res->status_line . ': ' . $res->message . ': null response')

              : !$json
              ? ($res->status_line . ': ' . $res->message .
                 ': non-JSON response: ' . $res->decoded_content)

              : $json->{error_description}
              ? $json->{error_description}

              : $json->{error}
              ? $json->{error}

              : $json->{errors}
              ? $json->{errors}->[0]->{title} . ': ' .
                $json->{errors}->[0]->{detail}

              : $json->{response} && $json->{response}->{errors}
              ? join (" ", @{$json->{response}->{errors}})

              : $json->{meta}
              ? $json->{meta}->{status} . ': ' . $json->{meta}->{msg}

              : "unknown"));

  my $remain = $res->header('x-ratelimit-remaining');
  my $reset  = $res->header('x-ratelimit-reset');
  if ($remain && $remain <= 0) {
    $err .= "; rate limit exceeded; resets at $reset";
    $noerror = 0;
  }

  return $err if ($noerror);
  error ("ERROR: $err");
}


sub mastodon_upload($$@) {
  my ($user, $caption, @imgs) = @_;

  my $retries = 8;
  my $delay   = 4;

  # To see what got posted:
  #
  #   wget -qO- https://$domain/api/v1/statuses/$id | jq -M
  #
  # Note that IDs are unique per server, vary from server to server,
  # and it doesn't matter which server the post originated on.

  utf8::decode($caption);       # Parse multi-byte UTF-8 into wide chars.
  $caption = html_unquote ($caption);
  $caption =~ s/\\n/\n/gs;

  # Max is 500 chars (not bytes).
  # (But each URL counts as 23 characters.)
  # (And the domain on @-mentions counts as zero.)
  $caption =~ s/^(.{494}).+$/$1 .../gs;

  error ("max of 4 images allowed") if (@imgs > 4);

  foreach my $img (@imgs) {
    my ($file, $alt) = @$img;
    my @pdata = load_photo_data ($file);
    push @$img, \@pdata;
  }

  my $mastodon = mastodon_login ($user);


  if (0) {   # Verify token
    my $url = 'https://' . $mastodon->{instance} .
              '/api/v1/apps/verify_credentials';
    my $res = $mastodon->{ua}->get ($url,
                                    Authorization =>
                                      'Bearer ' . $mastodon->{access});
    mastodon_error ("bad credentials", $res)
      unless ($res->is_success);
  }


  my @attach_ids  = ();
  my @attach_urls = ();

  # First upload each attachment.
  #
  foreach my $img (@imgs) {
    my ($file, $alt, $p) = @$img;
    my ($name, $ct, $file2, $thumb) = @$p;
    error ("when uploading video, there can be only one")
      if ($ct =~ m/^video/ && @imgs != 1);

    if ($debug_p) {
      print STDERR blurb() . "would have uploaded $ct \"$name\"\n";
      $file2 =~ s@^.*/@DEBUG-@s;
      push @attach_ids,  $file2;
      push @attach_urls, $file2;
      next;
    }

    utf8::decode($alt);       # Parse multi-byte UTF-8 into wide chars.
    $alt =~ s/^(.{494}).+$/$1 .../gs;  # Max is 500 chars (not bytes)
    $alt =~ s/\\n/\n/gs;

    # https://docs.joinmastodon.org/methods/media/
    my $url = 'https://' . $mastodon->{instance} . '/api/v1/media';


    # We sometimes get 5xx and need to retry...
    #
    my $res = undef;
    for (my $i = 0; $i < $retries; $i++) {
      $res = $mastodon->{ua}->post ($url,
                                    Authorization =>
                                      'Bearer ' . $mastodon->{access},
                                    Content_Type => 'form-data',
                                    Content      => { file => [ $file2 ],
                                                      description => $alt,
                                                      focus => "0.0,0.5",
                                    });
      last if ($res->is_success);
      sleep ($delay);
      $delay += 2;
    }

    mastodon_error ("uploading \"$name\"", $res)
      unless ($res->is_success);

    $delay = 4;
    print STDERR blurb() . "uploaded: \"$name\"\n"
      if ($verbose);

    my $json = json_decode ($res->decoded_content);
    error ("no json") unless ($json);
    my $id = $json->{id} ? $json->{id} : undef;
    error ("attachment failed: no ID: \"$name\"\n")
      unless $id;

    my $aurl = $json->{url} ? $json->{url} : undef;
    error ("attachment failed: no URL: \"$name\"\n")
      unless $aurl;

    error ("attachment failed: no type: \"$name\"\n")
      if (($json->{type} || 'unknown') eq 'unknown');

    push @attach_ids,  $id;
    push @attach_urls, $aurl;
  }

  # Next upload the text post itself, linking to attachments.
  # We sometimes get 5xx and need to retry...
  #
  my $url = 'https://' . $mastodon->{instance} . '/api/v1/statuses';

  if ($debug_p) {
    print STDERR blurb() . "would have posted \"$caption\"" .
          (@attach_ids ? ' ["' . join ('", "', @attach_ids) . '"]' : '') .
          "\n";
    return;
  }

  my $res = undef;
  for (my $i = 0; $i < $retries; $i++) {
    # https://docs.joinmastodon.org/methods/statuses/
    $res = $mastodon->{ua}->post ($url,
                                  Authorization =>
                                    'Bearer ' . $mastodon->{access},
                                  Content_Type =>
                                    'application/x-www-form-urlencoded',
                                  Content      => {
                                    status     => $caption,
                                    'media_ids[]' => [ @attach_ids ],
                                  });
    last if ($res->is_success);
    sleep ($delay);
    $delay += 2;
  }

  mastodon_error ("uploading \"$caption\"", $res)
    unless ($res->is_success);

  $delay = 4;
  print STDERR blurb() . "uploaded: \"$caption\"\n"
    if ($verbose);

  my $json = json_decode ($res->decoded_content);
  error ("no json") unless ($json);
  my $id = $json->{id} ? $json->{id} : undef;
  error ("post failed: no ID: \"$caption\"\n")
    unless $id;

  my $post_url = 'https://' . $mastodon->{instance} . '/@' . $user . '/' . $id;


  # Sometimes Mastodon just decides to not post the images, presumably when
  # the server is under high load.  We have already received an ID for the
  # attachment, and the attachment's URL exists and is functional; but the
  # server just somehow neglects to connect that attachment to the post.
  # It turns out that if we *edit* the post, we can (re-) attach the existing
  # attachment ID.  But sometimes it takes a while -- we have to out-wait a
  # "record not found" error on the just-made post before the edit succeeds.
  #
  # @attach_ids are the IDs we want.  @posted_ids are the IDs we got.
  #
  my @posted_ids  = ();
  my @posted_urls = ();
  if ($json->{media_attachments}) {
    foreach my $a (@{$json->{media_attachments}}) {
      push @posted_ids,  ($a->{id}  || 'NONE');
      push @posted_urls, ($a->{url} || 'NONE');
    }
  }

  if (join (', ', sort (@attach_ids)) ne
      join (', ', sort (@posted_ids))) {

    # Edit the status to re-attach the images.  Try several times.
    my $last_err = 'lost images';
    my $ok = 0;

    for (my $i = 0; $i < $retries; $i++) {
      print STDERR blurb() . "$last_err, attempting edit" .
                   ($i ? " " . ($i+1) : "") . "...\n"
        if ($verbose);
      sleep ($delay);
      $delay += 2;
      $url = 'https://' . $mastodon->{instance} . '/api/v1/statuses/' . $id;
      $res = $mastodon->{ua}->put ($url,
                                   Authorization =>
                                     'Bearer ' . $mastodon->{access},
                                   Content_Type =>
                                     'application/x-www-form-urlencoded',
                                   Content      => {
                                     status     => $caption,
                                     'media_ids[]' => [ @attach_ids ],
                                   });
      if (! $res->is_success) {
        $last_err = mastodon_error ('', $res, 1);
        next;
      }

      $json = json_decode ($res->decoded_content);
      error ("no json") unless ($json);

      # See if it worked.
      @posted_ids  = ();
      @posted_urls = ();
      if ($json->{media_attachments}) {
        foreach my $a (@{$json->{media_attachments}}) {
          push @posted_ids,  ($a->{id}  || 'NONE');
          push @posted_urls, ($a->{url} || 'NONE');
        }
      }

      if (join (', ', sort (@attach_ids)) eq
          join (', ', sort (@posted_ids))) {
        $ok = 1;
        last;
      }
    }

    if ($ok) {
        print STDERR blurb() . "repaired - $post_url\n"
          if ($verbose);
    } else {
      print STDERR blurb() . "WARNING: failed to repair images: " .
                   "$post_url " . join (' ', @attach_urls) . "\n";
    }
  }

  print STDOUT "$post_url\n" if ($verbose);
}


sub mastodon_backup($$) {
  my ($user, $dir) = @_;

  $dir =~ s@/+$@@s;

  my $mastodon = mastodon_login ($user);

  my $url = 'https://' . $mastodon->{instance} . '/api/v1/accounts/lookup' .
            '?acct=' . $user;
  print STDERR blurb() . "loading $url\n" if ($verbose > 1);
  my $res = $mastodon->{ua}->get ($url,
                                  Authorization =>
                                    'Bearer ' . $mastodon->{access});
  mastodon_error ("lookup", $res) unless ($res->is_success);
  my $json = json_decode ($res->decoded_content);
  my $uid = $json->{id} || error ("no id for $user");

  # https://docs.joinmastodon.org/methods/accounts/#statuses
  $url = 'https://' . $mastodon->{instance} . '/api/v1/accounts/' . $uid .
         '/statuses';
  $url .= '?limit=40';

  my $request_count = 0;
  my $max_id = undef;

  my $done = 0;
  while (!$done) {
    my $url2 = $url;
    $url2 .= '&max_id=' . $max_id if ($max_id);
    print STDERR blurb() . "loading $url2\n" if ($verbose > 1);
    $res = $mastodon->{ua}->get ($url2,
                                 Authorization =>
                                   'Bearer ' . $mastodon->{access});
    mastodon_error ("statuses", $res) unless ($res->is_success);
    $request_count++;

    $json = json_decode ($res->decoded_content);
    error ("no json") unless ($json);

    print STDERR blurb() . "  entries: " . scalar(@$json) . "\n"
      if ($verbose > 2);

    last unless (@$json);

    foreach my $status (@$json) {

      my $sid = $status->{id};
      my $date = str2time ($status->{created_at});
      my @tt = localtime($date);
      my $year = strftime ('%Y', @tt);
      my $time = strftime ("%Y%m%d-%H%M%S", @tt);
      my $file = "$dir/$year/$time-$sid.txt";

      my $text = (($status->{spoiler_text}
                   ? "Content Warning: " . $status->{spoiler_text} . "\n\n"
                   : "") .
                  $status->{content});

      if ($status->{reblog}) {
        $status = $status->{reblog};
        $text = ('Boosted ' . $status->{account}->{acct} . ': ' .
                 $status->{url} . "\n" .
                 ($status->{spoiler_text}
                  ? "Content Warning: " . $status->{spoiler_text} . "\n\n"
                  : "") .
                 $status->{content});
      } elsif ($status->{url}) {
        $text .= "\n" . $status->{url};
      }

      if ($status->{in_reply_to_id}) {
        my $id3 = $status->{in_reply_to_id};
        my $url3 = 'https://' . $mastodon->{instance} . '/api/v1/statuses/' .
                    $id3;
        print STDERR blurb() . "loading $url3\n" if ($verbose > 1);
        $res = $mastodon->{ua}->get ($url3,
                                     Authorization =>
                                       'Bearer ' . $mastodon->{access});
        $request_count++;

        if ($res->is_success) {
          $json = json_decode ($res->decoded_content);
          error ("no json") unless ($json);

          my $t = (($json->{spoiler_text}
                    ? "Content Warning: " . $json->{spoiler_text} . "\n\n"
                    : "") .
                   $json->{content});
          $t =~ s@<P\b[^<>]*>@\n\n@gsi;
          $t =~ s@<BR\b[^<>]*>@\n@gsi;
          $t =~ s/^/\t/gm;
          $text .= "\n\n" .
                   'In Reply To: ' . $json->{account}->{acct} . " " .
                  $json->{url} . "\n" .
                  $t;
        } else {

          my $err = mastodon_error ("in-reply-to $id3", $res, 1);

          # If this is a reply to a now-deleted comment, save it anyway.
          #
          if ($err =~ m/not found/si) {
            $url3 = 'https://' . $mastodon->{instance} . '/@' .
                    $status->{in_reply_to_account_id}  . '/' . $id3;
            print STDERR blurb() . "reply to comment $url3 - $err\n"
              if ($verbose);
            $text .= "\n\n" .
                     "In Reply To: $url3 - $err\n";
          } else {
            error ("ERROR: $err");
          }
        }
      }

      $text =~ s@<P\b[^<>]*>@\n\n@gsi;
      $text =~ s@<BR\b[^<>]*>@\n@gsi;
      $text =~ s@<[^<>]*>@@gs;
      $text = html_unquote ($text);
      $text =~ s/^\s+|\s+$//gs;
      $text =~ s/[ \t]+\n/\n/gs;
      $text =~ s/(\n\n)\n+/$1/gs;
      $text .= "\n" if ($text);

      if (-f $file) {
        print STDERR blurb() . "stopping at $file\n" if ($verbose > 1);
        $done = 1;
        last;
      }

      if ($debug_p) {
        print STDERR blurb() . "not writing $file\n";
      } elsif (-f $file) {
        print STDERR blurb() . "$file exists\n" if ($verbose);
      } else {        

        if (! -d "$dir") {
          mkdir ("$dir") || error ("mkdir $dir: $!");
        }

        if (! -d "$dir/$year") {
          mkdir ("$dir/$year") || error ("mkdir $dir/$year: $!");
        }

        open (my $out, '>:utf8', $file) || error ("$file: $!");
        print $out $text;
        close $out;
        print STDERR blurb() . "wrote $file\n" if ($verbose);
      }

      if ($status->{media_attachments} && @{$status->{media_attachments}}) {
        my $i = 0;
        foreach $a (@{$status->{media_attachments}}) {
          my $aid = $a->{id};

          my ($ext) = ($a->{url} =~ m@\.([^./]+)$@s);
          error ("no ext on attachment: " . $a->{url}) unless $ext;

          my $afile = $file;
          my $ii = sprintf("%02d-", $i);
          $ii = '' if (@{$status->{media_attachments}} == 1);
          $afile =~ s@\.[^./]+$@-$i$aid.$ext@s;

          $res = $mastodon->{ua}->get ($a->{url},
                                       Authorization =>
                                         'Bearer ' . $mastodon->{access});
          $request_count++;

          if (!$res->is_success) {
            # mastodon_error ("media", $res);
            my $err = mastodon_error ("media", $res, 1);
            print STDERR blurb() . "ERROR: $err\n";
            next;
          }

          if ($debug_p) {
            print STDERR blurb() . "not writing $afile\n";
          } elsif (-f $file) {
            print STDERR blurb() . "$afile exists\n" if ($verbose);
          } else {
            open (my $out, '>:raw', $afile) || error ("$afile: $!");
            print $out $res->decoded_content;
            close $out;
            print STDERR blurb() . "wrote $afile\n" if ($verbose);
          }
          $i++;
        }
      }

      if ($request_count > 100) {	# Try to avoid rate limiting
        my $delay = 30;
        print STDERR blurb() . "throttling for $delay secs\n" if ($verbose);
        sleep ($delay);
        $request_count = 0;
      }

      $max_id = $sid;
    }
  }
}



sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage(;$) {
  my ($err) = @_;
  print STDERR "$progname: $err\n" if $err;
  print STDERR "usage: $progname user [--verbose] [--caption txt]\n" .
               "\t\t [--alt txt] [--image filename]\n" .
               "\t\t [--alt txt] [--image filename] ...\n";
  print STDERR "usage: $progname user --backup DIR\n";
  print STDERR "usage: $progname user --generate-session\n";
  exit 1;
}

sub main() {
  binmode (STDOUT, ':utf8');
  binmode (STDERR, ':utf8');

  my $user = undef;
  my @imgs = ();
  my $caption = '';
  my $gen_p = 0;
  my $backup = undef;
  my $alt = '';
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/)    { $verbose++; }
    elsif (m/^-v+$/)        { $verbose += length($_)-1; }
    elsif (m/^--?debug$/)   { $debug_p++; }
    elsif (m/^--?caption$/) { $caption = shift @ARGV; }
    elsif (m/^--?gen(erate(-session)?)?$/) { $gen_p = 1; }
    elsif (m/^--?alt$/)     { $alt = shift @ARGV; }
    elsif (m/^--?image$/)   { push @imgs, [ shift @ARGV, $alt ]; $alt = ''; }
    elsif (m/^--?img$/)     { push @imgs, [ shift @ARGV, $alt ]; $alt = ''; }
    elsif (m/^--?backup$/)  { $backup = shift @ARGV; }
    elsif (m/^-./)          { usage ("unknown: $_"); }
    elsif (!$user)          { $user = $_; }
    else                    { usage("unknown: $_"); }
  }

  usage("no user") unless ($user);

  if ($gen_p) {
    generate_session ($user);
    exit (0);
  }

  usage("no caption or images") unless ($caption || @imgs || $backup);

  $progname = "$progname: $user";

  $Data::Dumper::Indent = 1;
  $Data::Dumper::Terse = 1;
  $Data::Dumper::Useqq = 1;
  $Data::Dumper::Quotekeys = 0;
  $Data::Dumper::Pair = "\t=> ";
  $Data::Dumper::Pad = "  ";

  error ("--alt must come before the --image to which it applies")
    if ($alt);

  if ($backup) {
    error ("--backup stands alone") if ($caption || @imgs);
    mastodon_backup ($user, $backup);
  } else {
    mastodon_upload ($user, $caption, @imgs);
  }
}

main();
exit 0;