#!/opt/bin/perl

=encoding utf8

=head1 NAME

mcp-imap - inspect and manage one IMAP account through MCP

=head1 SYNOPSIS

   mcp-imap [OPTION]...
   mcp-imap [OPTION]... login [method password|oauth2] [server HOST]
       [user USER] [tls connect|starttls|none] [port PORT] [oauth-KEY VALUE]...
   mcp-imap [OPTION]... providers [SEARCH]

=head1 DESCRIPTION

Each C<--name> selects one IMAP account and an independent MCP permission
profile. Configure the account with C<login>, then run the MCP server with
C<--stdio>, C<--connect>, or an HTTP listener. Login takes passwords from
the controlling terminal without echo, never from command-line arguments
or MCP tools.

The account is stored as C<imap-NAME.ini> under
C<$XDG_CONFIG_HOME/anyevent-mcp> or C<~/.config/anyevent-mcp>, mode 0600.
Password data is Base64 in that private file, not encrypted. Protect the
file like a password. Repeating C<login> replaces the saved password after
a successful connection. For C<login method oauth2>, it prints a browser
authorization URL and accepts the resulting redirect URL from the terminal,
without listening on a callback port. The private file stores the refresh
token; later IMAP sessions refresh access tokens automatically. Neither
passwords nor OAuth tokens are accepted as command-line values.
Unencrypted IMAP authentication is available only when explicitly selected
with C<login tls none>. This exposes credentials and message contents on the connection.

C<providers> searches Thunderbird's ISPDB domain index and OAuth provider
definitions. With no argument it lists known domains. A domain, substring,
or full email address selects a provider and looks up provider-hosted HTTPS
autoconfig (preferred) or Thunderbird's ISPDB as a fallback. It prints
shell-quoted password login commands for supported IMAP/TLS alternatives,
provider setup instructions, and OAuth commands if a matching public OAuth
registration is known. An email address fills in the username.
The commands are NOT executed. Thunderbird's client registrations may not
be usable by unrelated applications. OAuth authorization requests need
registered redirect URIs and may require provider-specific optional
C<oauth-auth-NAME VALUE> arguments (e.g. C<oauth-auth-access_type offline>).

See L</LOGIN KEYS> for an individually documented list of accepted
connection and OAuth2 settings, including their defaults.
Successful OAuth2 login requires a refresh token; provider-specific offline
access parameters may be necessary. Authorization is human-initiated only,
never exposed through an MCP tool. After authorization, the browser will
normally show an error page because no server is listening on the loopback
redirect URI. B<This is expected; copy the full redirect URL from the address
bar anyway.> Port 1 works with Chromium's error-page behavior, but provider
redirect registrations and other browsers may differ.

IMAP runs in a separate persistent synchronous worker, so an IMAP command
does not block the MCP event loop. One request at a time is processed by the
worker. While it is blocked, the frontend can send 30-second elapsed-time
progress notifications to clients that supply a progress token. These report
frontend liveness, not progress within Dovecot. A dropped connection during
a write can leave an unknown outcome; do not blindly retry such writes.
An idle connection is kept alive with IMAP NOOP (250-second default). A
failed keepalive (including a 30-second timeout) closes the connection
until the next tool call, which reconnects and authenticates. A connection
lost during an operation is not retried automatically.

When spawned as a multibroker stdio child, the server can exit after one
hour without MCP requests, discarding any SORT snapshot. The caller must
create a new snapshot if needed. Directly connected clients and HTTP
listeners are unaffected.

Message references consist of mailbox, UIDVALIDITY and UID. Read operations
use BODY.PEEK, never mark messages Seen. Deleted flags do not automatically
expunge. EXPUNGE is explicit. Selecting another mailbox or logging out does
not expunge. Search is bounded by UID windows, potentially returning a
partial/empty page with a continuation cursor when matches are sparse.
MCP mail processing requires C<Encode::MIME::Header> for RFC 2047
subject and address display-name decoding.
Additional character encodings are supported when optional Encode extensions
(C<Encode::HanExtra>, C<Encode::JIS2K>, C<Encode::EUCJPASCII>) are installed;
the IMAP worker loads available extensions without requiring them. An
unsupported charset yields a decoding error, not a silent empty message.

=head1 LOGIN KEYS

C<login> accepts C<KEY VALUE> pairs (without leading dashes).
Values not supplied are inherited from the saved account when available.
Changing authentication methods retains only the connection settings.
Passwords and OAuth tokens are never accepted on the command line.

=head2 Connection and authentication

=over

=item C<method password|oauth2>

Login method. Defaults to the saved method, or C<password> for a new account.

=item C<server HOST>

IMAP hostname. Read from standard input if unset.

=item C<user USER>

IMAP username, often a complete email address. Read from standard input
if unset.

=item C<tls connect|starttls|none>

C<connect> (default) negotiates TLS immediately, typically on port 993.
C<starttls> upgrades an initially cleartext connection before authenticating,
typically on port 143. C<none> skips TLS entirely, typically on port 143:
the username, password or OAuth token, and mail contents travel unencrypted.
Use C<none> only when the connection is otherwise protected, such as by a
trusted local transport. Some IMAP servers advertise C<LOGINDISABLED>
before TLS negotiation; if they also offer no supported SASL authentication
mechanism, C<tls none> cannot authenticate until the server's policy
permits cleartext authentication.

=item C<port PORT>

IMAP TCP port, default 993 for C<connect>, and 143 for
C<starttls> or C<none>. Changing C<tls> without specifying C<port>
selects that TLS mode's default port.

=back

=head2 OAuth2 keys (C<method oauth2>)

=over

=item C<oauth-client-id ID>

OAuth client ID registered with the provider (required).

=item C<oauth-authorization-endpoint URL>

Provider authorization endpoint, HTTPS (required).

=item C<oauth-token-endpoint URL>

Provider token endpoint, HTTPS (required).

=item C<oauth-scope TEXT>

Space-separated OAuth scopes (required).

=item C<oauth-redirect-uri URI>

Registered callback URI, HTTPS or HTTP loopback without query or fragment
(required). The program does not listen on this URI; copy the full URL
from the browser address bar after authorization.

=item C<oauth-client-secret SECRET>

Optional client secret for confidential OAuth clients. Supplied as a login
setting, not as an IMAP password.

=item C<oauth-client-auth none|client_secret_post|client_secret_basic>

OAuth token-endpoint authentication. Default C<none> without a client
secret, otherwise C<client_secret_post>. Non-C<none> modes require
C<oauth-client-secret>.

=item C<oauth-pkce 0|1>

Use PKCE S256, enabled by default (C<1>). Disable (C<0>) only if the
provider registration does not support PKCE.

=item C<oauth-sasl xoauth2|oauthbearer>

IMAP SASL mechanism for OAuth, default C<xoauth2>.

=item C<oauth-auth-NAME VALUE>

Add a provider-specific authorization query parameter, for example
C<oauth-auth-access_type offline> to request a refresh token.
NAME consists of ASCII letters, digits or underscores. Protocol-defined
parameters such as C<client_id>, C<redirect_uri> and C<state> cannot
be overridden.

=back

=head1 FIRST USE

Discover your provider's settings before logging in:

   mcp-imap --name personal providers alice@example.net

Replace the example address. This reports possible IMAP settings and
login commands; provider-specific OAuth client registrations may be
restricted to their original application. For a password-based provider,
for example:

   mcp-imap --name personal login method password \
      server imap.example.net user alice@example.net tls connect port 993

The password is read interactively. For OAuth2, run C<login method oauth2>
with your provider-approved client ID, authorization/token endpoints,
scope and redirect URI. For example, the structure of such a command
(the provider URLs and registration below are placeholders) is:

   mcp-imap --name personal login method oauth2 \
      server imap.example.net user alice@example.net tls connect port 993 \
      oauth-client-id REGISTERED_CLIENT_ID \
      oauth-authorization-endpoint https://login.example.net/authorize \
      oauth-token-endpoint https://login.example.net/token \
      oauth-scope MAIL_SCOPE \
      oauth-redirect-uri http://127.0.0.1:1

The redirect URI must be allowed by the OAuth client registration. Some
providers additionally require C<oauth-auth-access_type offline> or
other authorization parameters to issue a refresh token. After opening
the printed authorization URL, authorize the intended account and paste
the B<full> redirect URL from the browser's address bar even if the browser
reports an unreachable loopback page. Login checks IMAP authentication
before saving the account.

Then configure your MCP client to start:

   mcp-imap --name personal --stdio

Or expose it through a multibroker:

   mcp-multibroker --stdio mail --- mcp-imap --name personal --stdio ---

Ask the assistant:

   List my subscribed mailboxes, then show the ten newest subjects
   and senders in INBOX. Do not modify flags or move messages.

For example, to subscribe a folder called C<Receipts>, invoke C<mailbox>
with C<{"operation":"subscribe","mailbox":"Receipts"}>, then call C<lsub>
to see subscribed folders. Read operations request C<read> permission;
changing subscriptions requires C<manage>. A mailbox-specific permission
prompt can allow just that mailbox or all mailboxes.

To let a separately started server join an existing multibroker with
an HTTP/extension listener, run:

   mcp-imap --name personal --connect http://127.0.0.1:31740/TOKEN/mail

Replace C<TOKEN> with the token obtained using the multibroker's
C<--print-url>. Use C<https://> with a trusted, matching certificate.

The C<lsub> tool lists subscribed mailboxes; C<mailboxes> lists all
visible mailboxes. Subscriptions affect folder selection in clients,
not message delivery or permissions. See
L<AnyEvent::MCP::Intro/Read and organize mail> for search and safety
examples.

=head1 TOOLS

=over

=item mailboxes

List visible mailboxes. The C<mailboxes> result contains triples of
C<[attributes, hierarchy_separator, name]>. One entry might be
C<[["\\HasNoChildren"], "/", "INBOX"]>. Mailboxes marked C<\\Noselect>
are containers, not selectable message folders.

=item lsub

List subscribed mailboxes (IMAP LSUB). Uses the same result format as C<mailboxes>.

=item messages

List at most 1000 message summaries (default 100), newest UID first. Optional SEARCH
filter, summary fields, header names and UIDVALIDITY-aware cursor. Alternatively
pass C<uids> (1..1000) and C<uidvalidity> to retrieve those exact summaries in
requested order, without SEARCH. C<missing_uids> reports vanished messages;
do not combine explicit UIDs with cursor, filter or limit.
RFC 2047 encoded words in subject and address display fields are decoded
for display; explicitly requested arbitrary headers remain unchanged.
Searches at most 20000 UID values per call, not 20000 existing messages.
Sparse mailboxes may return an empty page with C<incomplete: true>.
Always continue with C<cursor: next_cursor> when C<next_cursor> is present,
preserving the original C<filter>. Repeating without the cursor rescans
the same UID interval. C<more> is true whenever continuation is needed,
even if no further match is guaranteed; false means the search is exhausted.
C<incomplete> specifically means the scan budget was reached. For targeted
whole-mailbox searches, use C<threads> with a selective filter.


C<filter> combines its keys with AND. Text search keys are C<from>, C<to>,
C<cc>, C<bcc>, C<subject>, C<body> and C<text> (headers and body).
C<header> maps header names to search strings. Date keys are C<since>,
C<before>, C<on>, C<sent_since>, C<sent_before> and C<sent_on>, with dates
as C<D-Mon-YYYY>. C<since>/C<before>/C<on> use the IMAP internal date;
C<sent_*> keys use the message's Date header. C<larger> and C<smaller>
filter by message size. Boolean flags include C<seen>, C<unseen>,
C<answered>, C<unanswered>, C<flagged>, C<unflagged>, C<deleted>,
C<undeleted>, C<draft>, C<undraft>, C<recent>, C<old> and C<new>.
C<all> and C<any> contain arrays of nested filters (AND and OR);
C<not> contains one nested filter. For example:

   {
     "mailbox": "INBOX",
     "limit": 20,
     "filter": {
       "since": "1-Nov-2026",
       "any": [
         {"from": "alice@example.net"},
         {"subject": "invoice", "body": "overdue"}
       ],
       "not": {"flagged": true}
     }
   }

The example finds messages with an internal date since November 1 from
Alice or containing both invoice in the subject and overdue in the body,
excluding flagged mail. Filter nesting and size are bounded; search
values are explicitly quoted as IMAP arguments, never interpolated into
raw SEARCH commands.

=item threads

Use C<UID THREAD ORDEREDSUBJECT UTF-8> (RFC 5256) on all messages in
the selected mailbox, or restrict candidates with C<filter> (the same
SEARCH criteria as C<messages>) and/or an inclusive C<uid_range> such
as C<1:5000>. Returns the server's nested UID thread arrays, ordered by
the oldest sent Date header within each subject group. Unlike C<messages>,
it searches the entire selected mailbox without the 20000-UID scan cap.
Useful for targeted lookups and uncertain MOVE destination verification;
fetch matching message details with C<messages> using explicit C<uids>
and C<uidvalidity>. A UID range is not a message count; gaps in assigned
UIDs reduce the matching population.
Optional C<uidvalidity> rejects references from a different mailbox
generation. The server must advertise C<THREAD=ORDEREDSUBJECT>. This
command does not fetch message summaries or mark mail as Seen. Thread
results are not paginated: the entire matching population is threaded
and returned, potentially expensive on large mailboxes. Restrict with
SEARCH criteria (e.g. C<before>) or C<uid_range> when appropriate.

=item sort_create

Run C<UID SORT (SUBJECT DATE) UTF-8> (RFC 5256) once, optionally with
the same C<filter> as C<messages>. Retain the complete ordered UID array
as one immutable snapshot in the worker; replace any previous snapshot
only after a successful sort. Return a random C<snapshot_id>, C<uidvalidity>,
C<count>, and the first page (default 100, maximum 1000 UIDs).
Subject groups are alphabetical,
with messages sorted by sent date inside each group, B<not> oldest group first.
The sort covers the entire matching mailbox and may be expensive.

=item sort_page

Retrieve a page from the current SORT snapshot using C<snapshot_id>,
C<mailbox>, zero-based C<offset> and C<limit> (default 100, maximum 1000).
Returns C<uids> and C<next_offset>, or null when exhausted. The page is
not recomputed when mail arrives, moves or disappears; fetch the returned
UIDs through C<messages> with C<uidvalidity> and tolerate C<missing_uids>.
A mailbox UIDVALIDITY change, replaced snapshot or worker restart fails
clearly. No disk persistence or automatic reconstruction.

=item sort_discard

Release the current SORT snapshot using its C<snapshot_id> and C<mailbox>.
Only one snapshot exists per worker; it is also discarded at worker exit.
These snapshot tools are read-only as far as IMAP messages are concerned.

=item previews

Fetch decoded text previews for 1..25 selected UIDs (C<uidvalidity> required).
Uses bounded C<BODY.PEEK> without setting Seen; C<max_bytes> defaults to 2048
and is capped at 4096 raw bytes per message. Returns selected MIME part,
content type, text and truncation status, or an individual error. Prefers
C<text/plain> when useful; falls back to C<text/html> if plain text is absent
or mostly a stub. HTML is converted to plain text while preserving link URLs.
When present, C<attachments> lists MIME part numbers, types, filenames,
transfer-encoded sizes in octets, and dispositions. Includes inline non-text
parts; uses the already-fetched BODYSTRUCTURE without downloading attachments.
Needs C<HTML::Parser> only when HTML text is selected. This is approximate
triage text, not full MIME rendering. Use C<message>/C<part> for complete mail.

=item message

Read ENVELOPE, flags, dates, size and MIME BODYSTRUCTURE for a UID.
RFC 2047 encoded words in ENVELOPE subjects and display names are decoded.
Use the C<uidvalidity> and C<uid> returned by C<messages> for the selected
mailbox. For example, if the current UIDVALIDITY is 13 and the UID is 42:

   {"mailbox": "INBOX", "uidvalidity": "13", "uid": 42}

=item part

Read a MIME part using BODY.PEEK with a byte ceiling. Returns Base64
raw transferred bytes; C<decode_text> additionally decodes complete text
parts using MIME transfer encoding and charset.

=item raw

Read raw RFC 5322 message bytes (bounded, Base64). Never sets Seen.

=item flags

Add/remove a set of IMAP flags, including Deleted (but never expunge).

=item copy, move

Copy or move named UIDs. MOVE requires server MOVE capability and has no
unsafe emulation.

=item append

APPEND a Base64-encoded RFC 5322 message up to 1 MiB. Use CRLF line
endings. Reject unescaped mbox From_ separator-like lines in the raw
message unless C<--allow-mbox-from> is set. Refusal identifies the raw
line number and explains the mboxo hazard. This uploads bytes unchanged;
it is not an SMTP send operation.

=item expunge

Permanently expunge explicitly named deleted UIDs when UIDPLUS is available,
or all Deleted messages in the selected mailbox when C<uids> is omitted.
Never fall back from UID EXPUNGE to whole-mailbox EXPUNGE.

=item mailbox

Create, rename, delete, subscribe or unsubscribe a mailbox.
Deletion first checks C<STATUS MESSAGES> and refuses mailboxes containing
any messages, including messages flagged C<\Deleted>. Expunge those
messages first, or use C<force> to bypass the check. The check is not
atomic with IMAP DELETE.

=back

=head1 PERMISSIONS

The independent profile is C<imap-NAME>, with C<read>, C<modify>,
C<manage> and C<expunge> actions. Each tool checks permission before
network activity. Mailbox-specific operations can be approved for one
mailbox or all mailboxes; C<mailboxes> and C<lsub> list folders without
selecting a mailbox. This worker is NOT filesystem- or network-sandboxed;
permissions authorize operations, not OS-level confinement.

=head1 OPTIONS

Shared switches are documented in
L<AnyEvent::MCP::Server::Simple/COMMON COMMAND-LINE OPTIONS>.
The C<--ask> switch is shared but has the following permission behavior;
the other switches below are specific to C<mcp-imap>.

=over

=item --ask MODE

Choose where permission prompts appear: C<helper> (default when run
independently) uses a local helper; C<tty> and C<yad> force those
local interfaces without fallback. C<mcp> delegates prompts to the
MCP client; C<auto> uses client elicitation when advertised and
otherwise falls back to the helper. C<none> denies unmatched requests
without prompting. A server spawned by a multibroker defaults to C<mcp>
so the broker can present its prompts.

=item --keepalive SECONDS

Send an IMAP NOOP after this many seconds without a tool call, to keep
the connection alive across NAT and server idle timeouts. Default 250.
Set to 0 to disable idle keepalives. The next tool call reconnects
automatically if the IMAP connection has closed.

=item --allow-mbox-from

Allow APPEND messages with unescaped mbox From_ separator-like lines.
Unsafe with mboxo servers which fail to escape these lines. Off by default;
can only be enabled by the server operator, not through an MCP tool.

=item --provider-file FILE

Use FILE as a local Thunderbird OAuth JavaScript source with the
C<providers> command. Invalid for normal server startup or C<login>.

=item --ispdb-file FILE

Use FILE as a local Thunderbird autoconfiguration XML source with the
C<providers> command. Invalid for normal server startup or C<login>.

=back

=cut

use common::sense;

use MIME::Base64 ();
use AnyEvent ();

use AnyEvent::Fork::Early;

use Term::ReadKey ();
use JSON::XS ();

use AnyEvent::Fork ();
use AnyEvent::Fork::RPC ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Config ();
use AnyEvent::MCP::Server::Permissions ();

use AnyEvent::MCP::Server::Simple;

my $options = mcp_getoptions
   {
      usage       => "Usage: mcp-imap [OPTION]... [login [key value ...] | providers [SEARCH]]\n",
      description => "Serve one named IMAP account; 'login' configures password or OAuth2; 'providers' discovers mail setup.",
      options     => [
         ["--allow-mbox-from", "Allow potentially unsafe unescaped mbox From_ lines in APPEND"],
         ["--keepalive SECONDS", "Idle IMAP NOOP interval (default 250; 0 disables)"],
         ["--provider-file FILE", "Use local Thunderbird OAuth source with providers"],
         ["--ispdb-file FILE", "Use local autoconfig XML with providers"],

         "Commands:",
         ["login [KEY VALUE]...", "Configure or update an account; credentials entered interactively"],
         ["providers [SEARCH]", "Discover providers and suggested login commands"],

         "Login keys (KEY VALUE, not --options):",
         ["method password|oauth2", "Authentication method (default password)"],
         ["server HOST", "IMAP hostname (prompts if missing)"],
         ["user USER", "IMAP username (prompts if missing)"],
         ["tls connect|starttls|none", "TLS from connection (default), STARTTLS upgrade, or explicitly no encryption"],
         ["port PORT", "Defaults: 993 for connect; 143 for starttls or none"],

         "OAuth2 login keys (method oauth2):",
         ["oauth-client-id ID", "Required OAuth client ID"],
         ["oauth-authorization-endpoint URL", "Required HTTPS authorization endpoint"],
         ["oauth-token-endpoint URL", "Required HTTPS token endpoint"],
         ["oauth-scope TEXT", "Required scope string"],
         ["oauth-redirect-uri URI", "Required registered HTTPS or loopback URI"],
         ["oauth-client-secret SECRET", "Optional OAuth client secret"],
         ["oauth-client-auth MODE", "none, client_secret_post, client_secret_basic"],
         ["oauth-pkce 0|1", "PKCE S256 (default 1)"],
         ["oauth-sasl MODE", "xoauth2 (default), oauthbearer"],
         ["oauth-auth-NAME VALUE", "Additional authorization parameter, e.g. access_type offline"],
      ],
      examples    => "  mcp-imap --name personal providers alice\@example.net\n"
         . "  mcp-imap --name personal login server imap.example.net user alice\@example.net tls connect\n"
         . "  mcp-imap --name local login server localhost user alice tls none\n"
         . "  mcp-imap --name personal --stdio",
   },
   "allow-mbox-from!" => \my $allow_mbox_from,
   "keepalive=i"       => \my $keepalive,
   "provider-file=s"   => \my $provider_file,
   "ispdb-file=s"      => \my $ispdb_file,
;

$keepalive //= 250;
$keepalive >= 0 or die "--keepalive must be nonnegative\n";

my $name = $options->{name};
if (@ARGV && $ARGV[0] eq "providers") {
   shift @ARGV;
   require AnyEvent::MCP::IMAP::Providers;
   AnyEvent::MCP::IMAP::Providers::run ($name, $provider_file, $ispdb_file, @ARGV);
   exit;
}
(defined $provider_file || defined $ispdb_file)
   and die "--provider-file and --ispdb-file are only for providers\n";

my $directory = ($ENV{XDG_CONFIG_HOME} || ($ENV{HOME} || die "HOME is not set\n") . "/.config")
              . "/anyevent-mcp";
my $file = "$directory/imap-$name.ini";

sub load_account {
   return {} unless -e $file;

   my $sections = AnyEvent::MCP::Config::parse_ini (AnyEvent::MCP::file_load ($file), $file);

   for (@$sections) {
      $_->[0] eq "" || $_->[0] eq "account"
         or die "$file: unexpected section $_->[0]\n";
   }
   my %kv = %{AnyEvent::MCP::Config::merge_sections ($sections, "account")->{account}};

   \%kv
}

sub settings {
   my ($kv) = @_;

   for (qw(server user tls port)) {
      defined $kv->{$_} && length $kv->{$_} or die "$file: missing $_; run mcp-imap --name $name login\n";
   }
   $kv->{tls} =~ /\A(?:connect|starttls|none)\z/
      or die "$file: invalid tls mode (expected connect, starttls, or none)\n";
   $kv->{port} =~ /\A[0-9]+\z/ && $kv->{port} >= 1 && $kv->{port} <= 65535
      or die "$file: invalid port\n";
   $kv->{server} !~ /[\s\x00-\x1f]/ && length $kv->{server} <= 255
      or die "$file: invalid server\n";
   $kv->{user} !~ /[\r\n\x00]/ or die "$file: invalid user\n";

   my %connection = map +($_ => $kv->{$_}), qw(server user port tls);
   my $method = $kv->{method} || "password";
   if ($method eq "oauth2") {
      require AnyEvent::MCP::IMAP::OAuth2;
      AnyEvent::MCP::IMAP::OAuth2::validate ($kv);
      defined $kv->{"oauth-refresh-token-base64"}
         && $kv->{"oauth-refresh-token-base64"} =~ /\A[A-Za-z0-9+\/]*={0,2}\z/
         && length $kv->{"oauth-refresh-token-base64"}
         or die "$file: missing or invalid OAuth refresh token; run mcp-imap login\n";
      return {
         %connection, method => "oauth2", account_file => $file, oauth => { %$kv },
      };
   }

   $method eq "password" or die "$file: invalid login method\n";
   defined $kv->{"password-base64"}
      && $kv->{"password-base64"} =~ /\A[A-Za-z0-9+\/]*={0,2}\z/
      && length $kv->{"password-base64"}
      or die "$file: missing or invalid password encoding\n";
   +{
      %connection, method => "password",
      password => MIME::Base64::decode_base64 ($kv->{"password-base64"}),
   }
}

sub login {
   @ARGV % 2 == 0 or die "login expects key/value pairs\n";
   my %input;
   while (@ARGV) {
      my ($key, $value) = splice @ARGV, 0, 2;
      $key =~ /\A(?:method|server|user|tls|port|oauth-(?:client-id|client-secret|client-auth|authorization-endpoint|token-endpoint|scope|pkce|redirect-uri|sasl|auth-[A-Za-z0-9_]+))\z/
         or die "Unknown login key '$key' (passwords and tokens cannot be given on argv)\n";
      $value = AnyEvent::MCP::utf8dec $value;
      $value !~ /[\r\n\x00]/ or die "Invalid $key\n";
      $input{$key} = $value;
   }
   my $old = load_account ();
   my $method = $input{method} || $old->{method} || "password";
   $method =~ /\A(?:password|oauth2)\z/ or die "Unknown login method\n";

   my %kv = %$old;
   %kv = map +(exists $old->{$_} ? ($_ => $old->{$_}) : ()), qw(server user tls port)
      if ($old->{method} || "password") ne $method;
   %kv = (%kv, %input);
   delete $kv{port} if exists $input{tls} && !exists $input{port} && ($old->{tls} // "") ne $input{tls};
   $kv{method} = $method;
   delete $kv{"password-base64"} if $method eq "oauth2";
   delete @kv{grep /^oauth-/, keys %kv} if $method eq "password";

   for my $key (qw(server user)) {
      next if defined $kv{$key} && length $kv{$key};
      print STDERR "$key: ";
      chomp ($kv{$key} = <STDIN> // "");
      $kv{$key} = AnyEvent::MCP::utf8dec $kv{$key};
   }
   $kv{tls} ||= "connect";
   $kv{port} ||= $kv{tls} eq "connect" ? 993 : 143;

   my $account;
   if ($method eq "oauth2") {
      require AnyEvent::MCP::IMAP::OAuth2;
      AnyEvent::MCP::IMAP::OAuth2::validate (\%kv);
      my ($url, $state, $verifier) = AnyEvent::MCP::IMAP::OAuth2::authorize (\%kv);
      print STDERR "Authorize the mail account '$kv{user}', not a different account already signed into the browser.\n";
      print STDERR "Open this OAuth authorization URL in a browser:\n$url\n\n";
      print STDERR "After authorization, the browser will display an error page because no server listens at the redirect URI.\n";
      print STDERR "This is expected. Copy the FULL URL from the browser address bar and paste it here.\n";
      open my $tty, "+<", "/dev/tty"
         or die "OAuth callback requires a controlling terminal: $!\n";
      print {$tty} "Paste redirected URL: ";
      Term::ReadKey::ReadMode ("noecho", $tty);
      my $redirect = <$tty>;
      Term::ReadKey::ReadMode ("restore", $tty);
      print {$tty} "\n";
      close $tty;
      defined $redirect or die "No OAuth redirect URL supplied\n";
      $redirect = AnyEvent::MCP::utf8dec $redirect;
      $redirect =~ s/\r?\n\z//;
      my $tokens = AnyEvent::MCP::IMAP::OAuth2::finish (\%kv, $state, $verifier, $redirect);
      my $refresh = $tokens->{refresh_token}
         or die "OAuth provider returned no refresh token; configure offline access and try again\n";
      $kv{"oauth-refresh-token-base64"} = MIME::Base64::encode_base64 (AnyEvent::MCP::utf8enc $refresh, "");
      $account = settings (\%kv);
      $account->{access_token} = $tokens->{access_token};
   } else {
      open my $tty, "+<", "/dev/tty"
         or die "Password requires a controlling terminal: $!\n";
      print {$tty} "IMAP password for $kv{user}\@$kv{server}: ";
      Term::ReadKey::ReadMode ("noecho", $tty);
      my $password = <$tty>;
      Term::ReadKey::ReadMode ("restore", $tty);
      print {$tty} "\n";
      close $tty;
      defined $password or die "No password supplied\n";
      $password =~ s/\r?\n\z//;
      length $password or die "Empty password\n";
      $kv{"password-base64"} = MIME::Base64::encode_base64 ($password, "");
      $account = settings (\%kv);
   }

   require AnyEvent::MCP::Worker::IMAP;
   AnyEvent::MCP::Worker::IMAP::imap_connect ($account);

   my $lock = AnyEvent::MCP::file_lock $file;
   AnyEvent::MCP::file_save $file,
      AnyEvent::MCP::Config::serialize_ini [["account", \%kv]];
   close $lock;

   print STDERR "Authenticated and saved account '$name' in $file\n";
}

if (@ARGV && $ARGV[0] eq "login") {
   shift @ARGV;
   login ();
   exit;
}

@ARGV and die "Unexpected arguments (try 'login')\n";

mcp_permissions +AnyEvent::MCP::Server::Permissions->new (
   name       => "imap-$name",
   actions    => {
      read    => "Read mailboxes and messages",
      modify  => "Change message flags, copy, move or append mail",
      manage  => "Create, rename, delete or subscribe mailboxes",
      expunge => "Permanently remove messages marked Deleted",
   },
);

sub imap_log_request {
   my ($server, $req) = @_;

   return unless $req->{method} eq "tools/call";
   my $args = $req->{args};
   my $json = JSON::XS->new->ascii->canonical;
   my %details;

   for my $key (qw(mailbox destination operation limit offset max_bytes uid_range part)) {
      $details{$key} = $json->encode (substr $args->{$key}, 0, 96)
         if defined $args->{$key} && !ref $args->{$key};
   }
   $details{count} = @{$args->{uids}} if ref $args->{uids} eq "ARRAY";
   $details{flags} = $json->encode ($args->{flags})
      if ref $args->{flags} eq "ARRAY";
   $details{before_uid} = $args->{cursor}{before_uid}
      if ref $args->{cursor} eq "HASH" && defined $args->{cursor}{before_uid}
         && !ref $args->{cursor}{before_uid};
   if (ref $args->{filter} eq "HASH") {
      my $search = $json->encode ($args->{filter});
      $details{search} = substr ($search, 0, 150) . (length $search > 150 ? "..." : "");
   } elsif (!exists $args->{filter} && !exists $args->{uids}
            && $req->{tool} =~ /\A(?:messages|threads|sort-create)\z/) {
      $details{search} = "ALL";
   }

   mcp_log_request $server, $req, %details;
}

mcp_config
   idle_exit          => 3600,
   on_request         => \&imap_log_request,
   server_name        => "mcp-imap",
   server_version     => $AnyEvent::MCP::VERSION,
   short_instructions => "Inspect and manage IMAP mail, by mailbox/UIDVALIDITY/UID. Reads do not set Seen; deletion requires explicit expunge.",
   instructions       => "One account per named mcp-imap instance. Read mailboxes and pages of messages; fetch MIME parts. "
                      . "Message operations require current UIDVALIDITY. Reads never set Seen. "
                      . "Deleting flags and expunging are separate; expunge permanently removes mail. "
                      . "An IMAP write interrupted by a disconnect has unknown outcome: never blindly repeat.";

my ($rpc, $rpc_dead, $connected);
my $idle_timer;
my %pending;
my $seq = 0;

sub arm_keepalive {
   undef $idle_timer;
   return unless $keepalive && $rpc && $connected && !%pending;
   $idle_timer = AnyEvent->timer (after => $keepalive, cb => sub {
      undef $idle_timer;
      return unless $rpc && !%pending;
      $rpc->("ping", {}, sub {
         my ($ok, $result) = @_;
         AE::log trace => "IMAP keepalive failed: $result" unless $ok;
         $connected = $ok ? 1 : undef;
         arm_keepalive () if $ok;
      });
   });
}

sub start_worker {
   return if $rpc;
   require AnyEvent::MCP::Worker::IMAP; # dependency check, no connection until authorized
   $rpc_dead = undef;

   $rpc = AnyEvent::Fork
      ->new
      ->require ("AnyEvent::MCP::Worker::IMAP")
      ->AnyEvent::Fork::RPC::run ("AnyEvent::MCP::Worker::IMAP::run",
         serialiser => $AnyEvent::Fork::RPC::JSON_SERIALISER,
         on_error => sub {
            $rpc_dead = $_[0];
            undef $idle_timer;
            undef $rpc;
            $connected = undef;
            for my $id (keys %pending) {
               my $req = delete $pending{$id};
               $req->error ("IMAP worker disconnected; outcome of in-flight writes unknown: $rpc_dead")
                  unless $req->{finished};
            }
         },
      );

   $connected = 0;
   my $account = settings (load_account ());
   $account->{allow_mbox_from} = $allow_mbox_from ? JSON::XS::true : JSON::XS::false;
   $rpc->("connect", $account, sub {
      my ($ok, $result) = @_;
      $connected = $ok ? 1 : undef;
      arm_keepalive () if $ok;
   });
}

sub perform {
   my ($req, $cmd, $args) = @_;
   undef $idle_timer;

   start_worker ();
   my $id = ++$seq;
   $pending{$id} = $req;
   $rpc->($cmd, $args, sub {
      delete $pending{$id} or return;
      my ($ok, $result, $alive) = @_;
      $connected = $ok || $alive ? 1 : undef;
      arm_keepalive ();
      return if $req->{finished};
      $ok ? $req->result ($result)
          : $req->error ($result);
   });
}

sub require_mail_permission {
   my ($req, $action, $args) = @_;

   my $mailbox = $args->{mailbox};

   $req->require_permission ({
      tool           => $req->{tool},
      action         => $action,
      (defined $mailbox ? (dimensions => {
         subject => {
            label   => "Mailbox",
            value   => "mailbox:$mailbox",
            choices => [
               { label => "this mailbox", match => "mailbox:$mailbox" },
               { label => "all mailboxes", match => "^mailbox:" },
            ],
         },
      }) : ()),
      sandbox_grants => [],
      reason         => "$req->{tool} " . (defined $mailbox ? "mailbox '$mailbox'" : "mailboxes"),
   });
}

sub property {
   my ($type, $description) = @_;

   +{ type => $type, description => $description }
}

my $mailbox = property ("string", "IMAP mailbox name, e.g. INBOX");
my $validity = property ("string", "Current UIDVALIDITY from messages or message");
my $uid = property ("integer", "Message UID");
my $uids = { type => "array", items => $uid, minItems => 1, maxItems => 1000 };

sub expose {
   my ($cmd, $description, $required, $properties, $action) = @_;

   mcp_tool $cmd => $description,
      {
         type                 => "object",
         required             => $required,
         additionalProperties => JSON::XS::false,
         properties           => $properties,
      },
      sub {
         my ($req, $args) = @_;

         ref $args eq "HASH" or die "Arguments must be an object\n";
         for my $key (@$required) {
            defined $args->{$key} or die "Missing $key\n";
         }
         if (defined $args->{mailbox}) {
            !ref $args->{mailbox} && length $args->{mailbox} && length $args->{mailbox} <= 1024
               or die "Invalid mailbox\n";
         }
         if (defined $args->{uidvalidity}) {
            !ref $args->{uidvalidity} && $args->{uidvalidity} =~ /\A[1-9][0-9]*\z/
               or die "Invalid UIDVALIDITY\n";
         }
         if (defined $args->{uid}) {
            !ref $args->{uid} && $args->{uid} =~ /\A[1-9][0-9]*\z/
               or die "Invalid UID\n";
         }
         for my $u (@{$args->{uids} || []}) {
            defined $u && !ref $u && $u =~ /\A[1-9][0-9]*\z/ or die "Invalid UID\n";
         }
         require_mail_permission $req, $action, $args;
         perform $req, $cmd, $args;
      };
}

expose mailboxes => "List IMAP mailboxes.", [],
   {}, "read";

expose lsub => "List subscribed IMAP mailboxes (LSUB).", [],
   {}, "read";

expose messages =>
   "Read up to 1000 summaries or explicit UIDs (default page size 100). 20000-UID scan budget: follow next_cursor even for empty pages. For targeted whole-mailbox lookup use threads.",
   ["mailbox"],
   {
      mailbox => $mailbox,
      uidvalidity => $validity,
      uids => $uids,
      limit   => { type => "integer", minimum => 1, maximum => 1000 },
      cursor  => { type => "object", description => "{uidvalidity, before_uid} from previous page" },
      fields  => { type => "array", items => property ("string", "Summary field") },
      headers => { type => "array", items => property ("string", "RFC 5322 header name"), maxItems => 20 },
      filter  => {
         type        => "object",
         description => "AND of: from/to/cc/bcc/subject/body/text strings; header:{Name:string}; "
                      . "since/before/on/sent_since/sent_before/sent_on dates (D-Mon-YYYY); "
                      . "larger/smaller byte counts; seen/unseen/answered/unanswered/flagged/unflagged/"
                      . "deleted/undeleted/draft/undraft/recent/old/new booleans; "
                      . "all:[filter,...], any:[filter,...], not:filter (recursive Boolean grouping)",
      },
   }, "read";

expose threads =>
   "Full-mailbox targeted SEARCH without messages' 20000-UID scan limit. Returns matching UIDs grouped by subject; no paging, can be expensive. Requires THREAD=ORDEREDSUBJECT.",
   ["mailbox"],
   {
      mailbox => $mailbox,
      uid_range => property ("string", "Optional inclusive START:END UID interval; e.g. 1:5000"),
      uidvalidity => $validity,
      filter => property ("object", "Optional SEARCH criteria, same as messages.filter; AND/OR/NOT allowed"),
   }, "read";

expose sort_create =>
   "UID SORT (SUBJECT DATE), save immutable worker-local UID snapshot, return first page. Replaces prior snapshot; expensive on large mailboxes.",
   ["mailbox"],
   {
      mailbox => $mailbox,
      filter => property ("object", "Optional SEARCH criteria, same as messages.filter"),
      limit => { type => "integer", minimum => 1, maximum => 1000 },
   }, "read";

expose sort_page =>
   "Read next UIDs from SORT snapshot by offset; no re-sort, no mail changes. Fetch summaries using messages(uids,uidvalidity).",
   [qw(mailbox snapshot_id)],
   {
      mailbox => $mailbox,
      snapshot_id => property ("string", "Opaque snapshot_id returned by sort_create"),
      offset => { type => "integer", minimum => 0 },
      limit => { type => "integer", minimum => 1, maximum => 1000 },
   }, "read";

expose sort_discard =>
   "Discard worker-local SORT snapshot without modifying mail.",
   [qw(mailbox snapshot_id)],
   { mailbox => $mailbox, snapshot_id => property ("string", "Opaque snapshot_id returned by sort_create") }, "read";

expose previews =>
   "Read up to 25 UID text previews using MIME-aware BODY.PEEK; keep URLs from HTML links. Never sets Seen.",
   [qw(mailbox uidvalidity uids)],
   {
      mailbox => $mailbox, uidvalidity => $validity,
      uids => { type => "array", items => $uid, minItems => 1, maxItems => 25 },
      max_bytes => { type => "integer", minimum => 1, maximum => 4096 },
   }, "read";

expose message => "Read one message's envelope, flags, size and MIME BODYSTRUCTURE; no Seen change.",
   [qw(mailbox uidvalidity uid)],
   { mailbox => $mailbox, uidvalidity => $validity, uid => $uid }, "read";

expose part => "Fetch bounded MIME part using BODY.PEEK. Raw transferred bytes in Base64; optionally decode text.",
   [qw(mailbox uidvalidity uid part)],
   {
      mailbox => $mailbox, uidvalidity => $validity, uid => $uid,
      part => property ("string", "BODYSTRUCTURE part number (empty for singlepart root)"),
      max_bytes => { type => "integer", minimum => 1, maximum => 262144 },
      decode_text => { type => "boolean" },
   }, "read";

expose raw => "Fetch bounded raw RFC 5322 bytes using BODY.PEEK, Base64 encoded.",
   [qw(mailbox uidvalidity uid)],
   { mailbox => $mailbox, uidvalidity => $validity, uid => $uid,
     max_bytes => { type => "integer", minimum => 1, maximum => 262144 } }, "read";

expose flags => "Add or remove Seen, Flagged, Answered, Deleted, Draft or supported keywords. Never expunges.",
   [qw(mailbox uidvalidity uids operation flags)],
   {
      mailbox => $mailbox, uidvalidity => $validity, uids => $uids,
      operation => { type => "string", enum => ["add", "remove"] },
      flags => { type => "array", items => property ("string", "IMAP flag or keyword"), minItems => 1, maxItems => 20 },
   }, "modify";

for my $cmd (qw(copy move)) {
   expose $cmd => ($cmd eq "move" ? "MOVE UIDs to destination; requires IMAP MOVE; no emulation."
                                 : "COPY UIDs to destination mailbox."),
      [qw(mailbox uidvalidity uids destination)],
      { mailbox => $mailbox, uidvalidity => $validity, uids => $uids,
        destination => property ("string", "Destination mailbox") }, "modify";
}

expose append => "Append raw CRLF RFC 5322 message (Base64, at most 1 MiB); reject unsafe mbox From_ lines.",
   [qw(mailbox data_base64)],
   {
      mailbox => $mailbox,
      data_base64 => property ("string", "Base64-encoded RFC 5322 message, max 1 MiB"),
      flags => { type => "array", items => property ("string", "Initial IMAP flag") },
   }, "modify";

expose expunge =>
   "Permanently expunge Deleted mail: optional UIDs require UIDPLUS; omitted UIDs expunge ALL Deleted messages.",
   [qw(mailbox uidvalidity)],
   { mailbox => $mailbox, uidvalidity => $validity, uids => $uids }, "expunge";

expose mailbox => "Create, rename, delete, subscribe or unsubscribe a mailbox; delete requires zero messages (even Deleted) unless force is true.",
   [qw(operation mailbox)],
   {
      operation => { type => "string", enum => [qw(create rename delete subscribe unsubscribe)] },
      mailbox => $mailbox,
      destination => property ("string", "New mailbox name for rename"),
      force => property ("boolean", "Delete mailbox even if it contains messages (delete only)"),
   }, "manage";

mcp_start %$options;
