2 # Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
3 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
4 # This is the normal command-line client for users
10 use File::Path::Expand qw/expand_filename/;
11 use File::Path qw/make_path/;
12 use File::Temp qw/tempfile/;
14 use Email::LocalDelivery;
15 use constant CRON_RAND_DELAY => 60; # adjust as necessary
16 Getopt::Long::Configure("require_order", "pass_through");
19 "help|h" => \$opts{help},
20 "quiet|q" => \$opts{quiet},
21 "force|f" => \$opts{force},
24 $ENV{SSOMA_HOME} ||= expand_filename("~/.ssoma");
26 # these expand automatically to the associated cmd_$name, so "add"
27 # calls cmd_add, "sync" calls cmd_sync, and so forth
30 doc => "start watching a new list",
31 arg => "LISTNAME URL TYPE:/path/to/destination [TARGET]",
32 long => "TYPE must be one of 'maildir', 'mbox', 'imap' ".
36 doc => "sync target(s) for existing LISTNAME",
37 arg => "[LISTNAME] [TARGET]",
40 'since=s' => \$opts{since},
41 'after=s' => \$opts{since},
45 doc => "show a message by Message-ID",
46 arg => "MESSAGE-ID [LISTNAME|GIT_DIR]",
50 my $cmd = shift @ARGV;
51 usage("", 1) unless defined $cmd;
52 $cmd eq "help" and usage("", 0);
53 $cmd{$cmd} or usage("", 1);
58 } or die "BUG: $cmd not implemented\n";
59 if (my $opt = $cmd{$cmd}->{opt}) {
60 GetOptions(%$opt) or usage(1);
67 my ($cmd, $exit) = @_;
68 my $fd = $exit ? \*STDERR : \*STDOUT;
69 print $fd "Usage: ssoma [opts] <command> [command-opts] [args]\n";
71 print $fd "Available commands:\n" unless $cmd;
73 foreach my $c (sort keys %cmd) {
74 next if $cmd && $cmd ne $c;
76 print $fd ' ', pack($pad, $c), $cmd{$c}->{doc}, "\n";
77 print $fd ' ', pack($pad, ''), $cmd{$c}->{arg}, "\n";
79 my $long = $cmd{$c}->{long};
81 print $fd ' ', pack($pad, ''), $long, "\n";
84 my $opt = $cmd{$c}->{opt} or next;
85 foreach (sort keys %$opt) {
86 # prints out arguments as they should be passed:
87 my $x = s#[:=]s$## ? '<arg>' :
88 (s#[:=]i$## ? '<num>' : '');
89 print $fd ' ' x 14, join(', ', map { length $_ > 1 ?
91 split /\|/, $_)," $x\n";
100 $name =~ /\A[a-zA-Z0-9]/ or die
101 "LISTNAME must start with an alphanumeric char\n";
102 $name =~ /[a-zA-Z0-9]\z/ or die
103 "LISTNAME must end with an alphanumeric char\n";
104 $name =~ /\A[\w\.\-]+\z/ or die
105 "LISTNAME must only contain alphanumerics, dashes, periods and underscores\n";
109 my ($listname, $url, $dest, $target) = @_;
110 (defined($url) && defined($listname) && defined($dest)) or
113 check_listname($listname);
115 $dest =~ /\A(mbox|maildir|command|imaps?):(.+)\z/ or
118 my ($type, $path) = ($1, $2);
121 if ($type =~ /\Aimaps?\z/) {
124 $path = File::Spec->rel2abs($path);
127 # Email::LocalDelivery relies on this trailing slash for
128 # maildir distinction
129 if (($type eq "maildir") && ($path !~ m!/\z!)) {
131 } elsif (($type eq "mbox") && ($path =~ m!/\z!)) {
132 die "mbox `$path' must not end with a trailing slash\n";
135 $target = "local" unless defined $target;
137 my $dir = "$ENV{SSOMA_HOME}/$listname.git";
138 make_path($ENV{SSOMA_HOME});
139 my $git = Ssoma::Git->new($dir);
141 push @init_args, '-q' if $opts{quiet};
142 $git->init_db(@init_args);
143 my $state = "$git->{git_dir}/ssoma.state";
146 local $ENV{GIT_CONFIG} = "$git->{git_dir}/config";
149 # no imap:// support in URI, yet, but URI has ftp://
152 $uri =~ s{\A(imaps?):}{ftp:};
154 my $u = URI->new($uri);
156 $u->scheme or die "no scheme from $dest\n";
157 defined(my $host = $u->host) or die "no host from $dest\n";
158 my $port = $u->_port;
159 x(qw/git config imap.port/, $port) if (defined $port);
160 x(qw/git config imap.host/, "$scheme://$host");
162 defined(my $user = $u->user) or die "no user in $dest\n";;
163 x(qw/git config imap.user/, $user);
166 defined $path or $path = "INBOX";
167 $path =~ s!\A/!!; # no leading slash
168 x(qw/git config imap.folder/, $path);
170 warn_imap_pass($u->password, $ENV{GIT_CONFIG});
172 # this only needs to be set for Extractor to follow
173 local $ENV{GIT_CONFIG} = $state;
174 x(qw/git config/, "target.$target.imap", "true");
176 local $ENV{GIT_CONFIG} = $state;
177 my $cfg = $type eq "command" ? "command" : "path";
178 x(qw/git config/, "target.$target.$cfg", $path);
182 $git->tmp_git_do(sub {
183 x(qw/git remote add --mirror=fetch origin/, $url);
190 foreach my $dir (glob("$ENV{SSOMA_HOME}/*.git")) {
197 my ($listname, @targets) = @_;
200 sleep(rand(CRON_RAND_DELAY));
202 if (defined $listname) {
203 check_listname($listname);
204 do_sync("$ENV{SSOMA_HOME}/$listname.git", \@targets);
206 foreach_list(sub { do_sync($_[0], []) });
211 my ($message_id, $listname) = @_;
213 # write to a temporary mbox because Email::LocalDelivery works
215 my ($fh, $mbox) = tempfile(TMPDIR => 1, SUFFIX => '.mbox');
217 if (defined $listname) {
218 my $path = -d $listname ? $listname
219 : "$ENV{SSOMA_HOME}/$listname.git";
220 do_cat($path, $message_id, $mbox);
222 foreach_list(sub { do_cat($_[0], $message_id, $mbox, 1) });
224 unlink $mbox or warn "error unlinking $mbox: $!\n";
227 print $_ or warn "failed printing to stdout: $!\n";
229 close $fh or die "error closing $mbox: $!\n";
233 my ($dir, $targets) = @_;
234 my $git = Ssoma::Git->new($dir);
235 my $ex = Ssoma::Extractor->new($git);
236 my $since = $opts{since};
238 # no targets? sync all of them
239 if (scalar(@$targets) == 0) {
240 my $cfg = $git->config_list("$git->{git_dir}/ssoma.state");
242 foreach my $k (keys %$cfg) {
243 $k =~ /\Atarget\.(\w+)\.(?:path|imap|command)\z/
251 $git->tmp_git_do(sub {
252 my @cmd = qw/git fetch/;
253 push @cmd, '-q' if $opts{quiet};
254 push @cmd, '-f' if $opts{force};
259 foreach my $target (@$targets) {
260 $ex->extract($target, $since);
265 system(@_) and die join(' ', @_). " failed: $?\n";
269 my ($pass, $file) = @_;
271 if (defined $pass && length $pass) {
273 ignoring IMAP password given on command-line
277 ensure $file is not world-readable if editing
278 $file to set imap.pass
283 my ($dir, $message_id, $mbox, $missing_ok) = @_;
284 my $git = Ssoma::Git->new($dir);
285 my $ex = Ssoma::Extractor->new($git);
286 $ex->midextract($message_id, $mbox, $missing_ok);