fixes for comments

[d.git] / fyvzl

diff --git a/fyvzl b/fyvzl
index 4fa8fbdd10cf40bcc59eaf2a8d34383ba5739895..8fe4e73c429548124cafbe0a0149ff41817655e7 100755 (executable)
--- a/fyvzl
+++ b/fyvzl
@@ -1,18 +1,27 @@
 #!/usr/bin/perl -w
 our $usage1 = <<'END';
-usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-dDOM] [-qQUALDOM] DATABASE-FILE ACTION ARG
+usage: ../fyvzl [OPTIONS DATABASE-FILE ACTION ARG
+options
+  -lLENGTH   (for create)
+  -mMAXPERUSER
+  -dDOM
+  -qQUALDOM
+  -C     (show comments in output)
+  -h     (display help)
 END
 our $usage2 = <<'END';
 actions
-  create [REDIRECT-TO]
-  update LOCAL-PART REDIRECT-TO
-  reject LOCAL-PART
+  create [REDIRECT] [#COMMENT]
+  update LOCAL-PART [REDIRECT] [#COMMENT]
   show LOCAL-PART
   list
   list-actions
+empty value for REDIRECT means reject
+END
+our $usage3 = <<'END';
 privileged actions
   list-user USER
-  insert-exact LOCAL-PART USER REDIRECT
+  insert-exact LOCAL-PART USER REDIRECT COMMENT
   donate LOCAL-PART USER
   enable-user|disable-user USER
 END
@@ -29,6 +38,7 @@ our $dbh;
 our $dom;
 our $user;
 our $priv;
+our $showcomment;
 
 sub nextarg () {
     die "too few arguments\n" unless @ARGV;
@@ -60,11 +70,15 @@ sub prow ($) {
     }
     my $pa = $row->{'localpart'};
     $pa .= '@'.$dom if defined $dom;
-    if (defined $row->{'redirect'}) {
-       print "$pa: $row->{'redirect'}\n";
+    if (length $row->{'redirect'}) {
+       print "$pa: $row->{'redirect'}" or die $!;
     } else {
-       print "# reject $pa\n";
+       print "# reject $pa" or die $!;
+    }
+    if ($showcomment || !$priv) {
+       print " #$row->{'comment'}" or die $!;
     }
+    print "\n" or die $!;
 }
 
 sub goodrand ($) {
@@ -80,11 +94,15 @@ sub goodrand ($) {
     }
 }
 
-sub qualify ($) {
-    my ($t) = @_;
-    return $t if $t =~ m/\@/;
-    die "unqualified redirection target\n" unless defined $qualdom;
-    return $t.'@'.$qualdom;
+sub qualify (\$) {
+    my ($ref) = @_;
+    if (defined $$ref && $$ref =~ m/[^\041-\177]/) {
+       die "bad characters in redirection target\n";
+    }
+    if (defined $$ref && length $$ref && $$ref !~ m/\@/) {
+       die "unqualified redirection target\n" unless defined $qualdom;
+       $$ref .= '@'.$qualdom;
+    }
 }
 
 sub insertrow ($) {
@@ -92,14 +110,26 @@ sub insertrow ($) {
     my $stmt =
        "INSERT INTO addrs (".
        (join ",", sort keys %$row).
-       ") VALUES (?, ?, ?) ";
+       ") VALUES (".
+       (join ",", map { "?" } sort keys %$row).
+       ") ";
     $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
 }
 
+sub rhsargs ($) {
+    my ($row) = @_;
+    while (@ARGV) {
+       $_ = shift @ARGV;
+       my $f = (s/^\#// ? 'comment' : 'redirect');
+       die "$f supplied twice\n" if exists $row->{$f};
+       $row->{$f} = $_;
+    }
+    qualify $row->{'redirect'};
+    return $row;
+}
+
 sub action_create {
-    my $redirect;
-    if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
-    $redirect = qualify $redirect;
+    my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''});
     open R, "/dev/urandom" or die $!;
     binmode R;
     my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?");
@@ -123,39 +153,43 @@ sub action_create {
        last if !$row;
        $dbh->abort();
     }
-    my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
-    insertrow($row);
+    $newrow->{'user'} = $user;
+    $newrow->{'localpart'} = $s;
+    insertrow($newrow);
     $dbh->commit();
-    prow($row);
+    prow($newrow);
+}
+
+sub selectrow ($) {
+    my ($localpart) = @_;
+    our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
+    $row_q->execute($localpart);
+    return $row_q->fetchrow_hashref();
 }
 
 sub begin_row ($) {
     my ($localpart) = @_;
     my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
-    $q->execute($localpart);
-    my $row = $q->fetchrow_hashref();
+    my $row = selectrow $localpart;
     die "unknown localpart\n" unless defined $row;
     die "not owned by you\n" unless $priv || $row->{user} eq $user;
     return $row;
-                }
-
-sub action_update {
-    my $localpart = nextarg;
-    my $redirect = qualify nextarg;
-    nomoreargs;
-    begin_row($localpart);
-    $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
-            {}, $redirect, $localpart);
-    $dbh->commit;
 }
 
-sub action_reject {
+sub action_update {
     my $localpart = nextarg;
+    my $updrow = rhsargs({});
     nomoreargs;
     begin_row($localpart);
-    $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
-            {}, $localpart);
+    foreach my $f (qw(redirect comment)) {
+       my $v = $updrow->{$f};
+       next unless defined $v;
+       $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?",
+                {}, $v, $localpart);
+    }
+    my $row = selectrow $localpart;
     $dbh->commit;
+    prow($row);
 }
 
 sub action_show {
@@ -184,11 +218,12 @@ sub action_list_user {
 
 sub action_insert_exact {
     die unless $priv;
-    my $localpart = nextarg;
-    $user = nextarg;
-    my $redirect = nextarg;
+    my $row = { };
+    $row->{'localpart'} = nextarg;
+    $row->{'user'} = $user = nextarg;
+    $row->{'redirect'} = nextarg;
+    $row->{'comment'} = nextarg;
     nomoreargs;
-    my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
     insertrow($row);
     $dbh->commit;
 }
@@ -228,18 +263,24 @@ while (@ARGV) {
     last unless $ARGV[0] =~ m/^-/;
     $_ = shift @ARGV;
     last if m/^--?$/;
-    if (m/^-l(\d+)$/) {
-       $randlength = $1;
-    } elsif (m/^-m(\d+)$/) {
-       $maxperuser = $1;
-    } elsif (m/^-d(\S+)$/) {
-       $dom = $1;
-    } elsif (m/^-q(\S+)$/) {
-       $qualdom = $1;
-    } elsif (m/^-h$/) {
-       print $usage1.$usage2 or die $!;
-    } else {
-       die "unknown option \`$_'\n";
+    for (;;) {
+       last unless m/^-./;
+       if (s/^-l(\d+)$//) {
+           $randlength = $1;
+       } elsif (s/^-m(\d+)$//) {
+           $maxperuser = $1;
+       } elsif (s/^-d(\S+)$//) {
+           $dom = $1;
+       } elsif (s/^-q(\S+)$//) {
+           $qualdom = $1;
+       } elsif (s/^-C/-/) {
+           $showcomment = 1;
+       } elsif (s/^-h/-/) {
+           print $usage1.$usage2.$usage3 or die $!;
+           exit 0;
+       } else {
+           die "unknown option \`$_'\n";
+       }
     }
 }