chiark / gitweb /
comments
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Fri, 30 Aug 2013 14:33:48 +0000 (15:33 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Fri, 30 Aug 2013 14:33:48 +0000 (15:33 +0100)
fyvzl
schema

diff --git a/fyvzl b/fyvzl
index 4fa8fbdd10cf40bcc59eaf2a8d34383ba5739895..24ad9ae7775572040396425a0e50862247acb56e 100755 (executable)
--- a/fyvzl
+++ b/fyvzl
@@ -1,18 +1,25 @@
 #!/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
+  create [REDIRECT-TO] [#comment]
+  update LOCAL-PART [REDIRECT-TO] [#comment]
   reject LOCAL-PART
   show LOCAL-PART
   list
   list-actions
 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 +36,7 @@ our $dbh;
 our $dom;
 our $user;
 our $priv;
+our $showcomment;
 
 sub nextarg () {
     die "too few arguments\n" unless @ARGV;
@@ -61,10 +69,14 @@ sub prow ($) {
     my $pa = $row->{'localpart'};
     $pa .= '@'.$dom if defined $dom;
     if (defined $row->{'redirect'}) {
-       print "$pa: $row->{'redirect'}\n";
+       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 +92,12 @@ 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/\@/) {
+       die "unqualified redirection target\n" unless defined $qualdom;
+       $$ref .= '@'.$qualdom;
+    }
 }
 
 sub insertrow ($) {
@@ -92,14 +105,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,30 +148,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;
+    my $updrow = rhsargs({});
     nomoreargs;
     begin_row($localpart);
-    $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
-            {}, $redirect, $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_reject {
@@ -228,18 +266,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 or die $!;
+           exit 0;
+       } else {
+           die "unknown option \`$_'\n";
+       }
     }
 }
 
diff --git a/schema b/schema
index c14c315657573a6049cd3d835461a2d9a9dff1b4..58c8ecea22c0589a750208e14fe02b1b3cef8d03 100644 (file)
--- a/schema
+++ b/schema
@@ -1,7 +1,8 @@
 CREATE TABLE addrs (
        localpart       STRING PRIMARY KEY,
        user            STRING NOT NULL,
-       redirect        STRING
+       redirect        STRING,
+       comment         STRING NOT NULL
 );
 CREATE TABLE disabled_users (
        user            STRING PRIMARY KEY