#!/usr/bin/perl -w
use strict;
+use Carp;
our $us = $0; $us =~ s#.*/##;
our $usage = <<'END';
usage:
$us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
$us [<opts>] assign <number>|<localpart>@[domain] <comment>
- $us [<opts>] show <count> } will generate more aliases
- $us [<opts>] range [<from>-[<to>]] } if necessary
+ $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 $us to edit the comment of a pregen alias;
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;
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 die "$r ?";
+ ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
return $r;
}
-sub fetch_list {
- open P, "-!", $generator, qw(list) or die $!;
+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 $_ ?";
$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 generate ($) {
+sub fetch_list () {
+ run_generator qw(list);
+}
+
+sub perhaps_generate ($) {
my ($num) = @_;
- return undef if $no_generate;
my $alias = $by_number[$num];
return $alias if $alias;
- run_generator qw(create)
- $!=0; $?=0; (system $generator, qw(create), comment_make $num)
- ==0 or die "$generator failed ($! $?)";
-
+ 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 {
+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) {
- my $wanted = $target->{Number}+1;
- generate $wanted
- or print STDERR <<END
+ 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;
+ }
+}
+
+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/^--?$/;
- while ($arg !~ m/^-$/) {
+ while ($arg =~ m/^-./) {
if ($arg =~ s/^-[ldFm]/-/) {
push @genopts, $arg;
- } elsif ($arg =~ s/^-G//) {
- $generator = $'; #';
- } elsif ($arg =~ s/^-N//) {
+ } 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 = $us;
-$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\>'([1-9]\d{0,8})'g) == 1 #'
- or badusage "comment pattern must contain \`<number>' exactly once";
+($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;
~ijackson / evade-mail-usrlocal.git / blobdiff