#!/usr/bin/perl -w
use strict;
-our $pgm = $0; $pgm =~ s#.*/##;
+use Carp;
+our $us = $0; $us =~ s#.*/##;
our $usage = <<'END';
usage:
- $pgm [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
- $pgm [<opts>] assign <number>|<localpart>@[domain] <comment>
- $pgm [<opts>] show <count> } will generate more aliases
- $pgm [<opts>] range [<from>-[<to>]] } if necessary
+ $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
+ $us [<opts>] assign <number>|<localpart>@[domain] <comment>
+ $us [<opts>] list
+ $us [<opts>] some <count> } will generate aliases
+ $us [<opts>] range <min>-<max>|<min>+<count> } as necessary
opts:
-G<generator> generator/lister program
-N do not generate more aliases
+ -q do not show domain, just local part
-l.., -d.., -F.., -m.. passed to generator
notes:
- Always use $pgm to edit the comment of a pregen alias;
+ Always use $us to edit the comment of a pregen alias;
otherwise we may lose track of the next number alias to pregenerate
and reuse numbers.
<comment> must always start with #, and you will need to quote the
whole comment to protect it from your shell
END
+sub fail { die "$us: @_\n"; }
+sub badusage { fail "bad usage: @_"; }
+sub failstdout () { fail "stdout: $!"; }
+
our $generator;
+our $no_generate=0;
+our $show_domain=1;
our @genopts;
-sub fetch_list {
- open P, "-!", $generator, qw(list) or die $!;
+our %by_localpart;
+our @by_number;
+our $min_number;
+
+our $comment_pattern = '### PREGEN <number>';
+our $comment_re;
+
+open DEBUG, ">/dev/null" or die $!;
+
+sub debug {
+ print DEBUG "$us: DEBUG: ", @_, "\n" or die $!;
+}
+
+sub debug_cmd {
+ debug "running ", join ' ',
+ map {
+ if (m/[^-_.=+0-9a-z]/i) {
+ my $s = $_;
+ $s =~ s/['\\]/'\\$&'/g;
+ "'$s'";
+ } else {
+ $_;
+ }
+ } @_;
+}
+
+sub comment_make ($) {
+ my ($num) = @_;
+ my $r = $comment_pattern;
+ ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
+ return $r;
+}
+
+sub run_generator {
+ my @genargs = @_;
+ my @cmd = ($generator, @genargs);
+ debug_cmd @cmd;
+ open P, "-|", @cmd or fail "fork $generator: $!";
while (<P>) {
- my ($alias,$user);
+ my ($alias,$comment);
+ chomp or fail "$generator truncated output?";
+ debug "| ", $_;
if (m/^\# user/) {
next;
} elsif (m/^\# reject (\S+) (\#.*)$/) {
($alias,$comment) = ($1,$2);
} elsif (m/^\#/) {
next; # future extension
- } elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
+ } elsif (m/^([^#: ]+)\: [^#]* (\#.*)$/) {
($alias,$comment) = ($1,$2);
} else {
die "generator output $_ ?";
my $localpart = $alias;
$localpart =~ s/\@.*//;
my $row = { Alias => $alias, LocalPart => $localpart };
- if ($comment =~ m/^### PREGEN ([1-9]\d{0,8})$/) {
+ if ($comment =~ m/^$comment_re$/o) {
$row->{Number}= $1;
}
$by_localpart{$row->{LocalPart}} = $row;
- $by_number[$row->{Number}] = $row if defined $row->{Number};
+ if (defined $row->{Number}) {
+ $by_number[$row->{Number}] = $row;
+ $min_number = $row->{Number} if
+ (!defined $min_number) || $min_number > $row->{Number};
+ }
}
- $?=0; $!=0; close P or die "$generator $! $?";
-
+ $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n";
}
-sub parse_target {
+sub fetch_list () {
+ run_generator qw(list);
+}
+
+sub perhaps_generate ($) {
+ my ($num) = @_;
+ my $alias = $by_number[$num];
+ return $alias if $alias;
+ return undef if $no_generate;
+ return undef unless $num > $#by_number;
+ run_generator qw(create), (comment_make $num);
+ $alias = $by_number[$num];
+ confess "$num ?" unless $alias;
+ return $alias;
+}
+
+sub parse_target () {
@ARGV or badusage "missing specification for alias to change";
my $spec = shift @ARGV;
my $target;
if ($spec =~ m/^(\d{1,9})$/) {
$target = $by_number[$spec];
- die "no alias number $target\n" unless $target;
+ fail "no alias number $spec (already assigned perhaps?)" unless $target;
} elsif ($spec =~ m/^(.*)\@[^\@]*/) {
$target = $by_localpart{$1};
- die "no alias with local part \`$1'\n" unless $target;
- die "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'\n"
+ fail "no alias with local part \`$1'" unless $target;
+ fail "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'"
unless $spec eq $target->{Alias} ||
$spec eq $target->{LocalPart}.'@';
} else {
badusage "bad specification for alias to change";
}
+ return $target;
+}
+
+sub report ($) {
+ my ($alias) = @_;
+ confess unless $alias;
+ print $alias->{Number}, ' ',
+ $alias->{ $show_domain ? 'Alias' : 'LocalPart' }, "\n"
+ or failstdout;
}
sub action_update {
- my $target = parse_target;
+ my $target = parse_target();
@ARGV or badusage "missing update info\n";
if (defined $target->{Number} && $target->{Number} == $#by_number) {
- generate $target->{Number}+1;
+ my $wanted = $#by_number + 1;
+ perhaps_generate $wanted
+ or print STDERR <<END or fail "stderr: $!"
+$us: Losing track of next number ($wanted), due to use of -N;
+$us: will start next alias at #0, unless you say (e.g.) "range $wanted".
+END
}
- exec $generator, qw(update), $target->{Alias}, @ARGV;
- die "$generator: $!";
+ my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
+ debug_cmd @cmd;
+ exec @cmd or fail "exec $generator: $!";
}
sub action_assign {
action_update;
}
+sub action_list {
+ @ARGV==0 or
+ badusage "invalid arguments to list";
+ my $num = $min_number;
+ $num ||= 0;
+ for (; $num <= $#by_number; $num++) {
+ my $alias = $by_number[$num];
+ report $alias if $alias;
+ }
+}
- (@ARGV==1 && $ARGV[0] =~ or badusage "missing assignment info (new comment)";
- $ARGV[0]=~
+sub action_some {
+ (@ARGV==1 &&
+ $ARGV[0] =~ m/^(\d+)$/s) or
+ badusage "invalid arguments to some";
+ my ($count) = $1;
+ my $num = $min_number;
+ $num ||= 0;
+ for (; $count > 0; $num++) {
+ my $alias = perhaps_generate $num;
+ if ($alias) {
+ report $alias;
+ $count--;
+ } else {
+ if ($num > $#by_number) {
+ print STDERR <<END or fail "stderr: $!";
+$us: fewer than requested aliases printed, due to -N
+END
+ last;
+ }
+ }
+ }
+}
+
+sub action_range {
+ (@ARGV==1 &&
+ $ARGV[0] =~ m/^(\d+)(?:([-+])(\d+))?$/s) or
+ badusage "invalid arguments to range";
+ my ($num,$op,$rarg) = ($1,$2,$3);
+ my $limit =
+ $op eq '+' ? $num+$rarg-1 :
+ $op eq '-' ? $rarg :
+ confess "$op ??";
+ for (; $num<=$limit; $num++) {
+ my $alias = perhaps_generate $num;
+ report $alias if $alias;
+ }
+}
for (;;) {
last unless @ARGV;
last unless $ARGV[0] =~ m/^-/;
my $arg = shift @ARGV;
last if $arg =~ m/^--?$/;
- if ($arg =~ m/^-[ldFm]/) {
- push @genopts, $arg;
- } elsif ($arg =~ m/^-G/) {
- $generator = $'; #';
- } else {
- badusage "unknown option \`$arg'";
+ while ($arg =~ m/^-./) {
+ if ($arg =~ s/^-[ldFm]/-/) {
+ push @genopts, $arg;
+ } elsif ($arg =~ s/^-G(.*)//) {
+ $generator = $1;
+ } elsif ($arg =~ s/^-D/-/) {
+ open DEBUG, ">&STDERR" or die $!;
+ } elsif ($arg =~ s/^-q/-/) {
+ $show_domain = 0;
+ } elsif ($arg =~ s/^-N/-/) {
+ $no_generate = 1;
+ } else {
+ badusage "unknown option \`$arg'";
+ }
}
}
-our $child = $pgm;
-$child =~ s/-pregen/; fixme fixme this should be defaulting generator
+if (!defined $generator) {
+ $generator = $us;
+ $generator =~ s/-pregen$//
+ or fail "unable to calculate default generator".
+ " (want to strip \`-pregen' from our program name, \`$us')";
+}
+
+$comment_pattern =~ m/^#/s
+ or badusage "comment pattern must start with \`#'";
+$comment_re = $comment_pattern;
+$comment_re =~ s/\W/\\$&/g;
+($comment_re =~ s'\\<number\\>'(0|[1-9]\d{0,8})'g) == 1 #'
+ or badusage "comment pattern (\`$comment_pattern')".
+ " must contain \`<number>' exactly once";
-@ARGV or badusage "missing action\n";
+if (!@ARGV) {
+ print STDERR $usage or die $!;
+ exit 1;
+}
my $action = shift @ARGV;
+
+fetch_list();
+
$action =~ y/-/_/;
-{ no strict qw(refs); &{"action_$action"}; }
+my $actionsub;
+{ no strict qw(refs); $actionsub = \&{"action_$action"}; }
+defined $actionsub or badusage "unknown action $action";
+$actionsub->();
+
+close STDOUT or failstdout;