X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/odin-cgi/blobdiff_plain/c86aee467ae463cd3fc7ff896f09f2a07d79dad5..49bed39b1f7caa2bd957a1684c356751960c9fda:/lib/Odin.pm

diff --git a/lib/Odin.pm b/lib/Odin.pm
index 7182af2..1d50fe9 100644
--- a/lib/Odin.pm
+++ b/lib/Odin.pm
@@ -24,8 +24,8 @@ our $DSN = "dbi:Pg(pg_enable_utf8=>1):host=db";
 our $RETRY = 10;
 our @BACKOFF = (0.1, 10, 1.5, 0.5, 2.0);
 
-our $BASEURL = "http://odin.gg/";
-our $STATIC = "http://odin.gg/";
+our $BASEURL = "https://odin.gg/";
+our $STATIC = "https://odin.gg/static/";
 
 our $SHORTURL_PATH = "u";
 our $PASTEBIN_PATH = "p";
@@ -376,6 +376,16 @@ our @PASTEBIN_PROPS = keys %PASTEBIN_DEFAULTS;
 our $PASTEBIN_PROPCOLS = join ", ", @PASTEBIN_PROPS;
 our $PASTEBIN_PROPPLACES = join ", ", map "?", @PASTEBIN_PROPS;
 
+sub check_lang ($) {
+  my ($lang) = @_;
+
+  return unless defined $lang;
+  my $db = open_db;
+  @{$db->selectall_arrayref
+    ("SELECT lang FROM odin_pastebin_lang WHERE lang = ?", undef, $lang)}
+    or fail "unknown language `$lang'";
+}
+
 sub new_pastebin (\%) {
   my ($new) = @_;
 
@@ -384,6 +394,7 @@ sub new_pastebin (\%) {
   my $tag;
 
   merge_hash %$new, %PASTEBIN_DEFAULTS;
+  check_lang $new->{lang};
   xact {
     $tag = encode_tag next_seq $db, "odin_pastebin_seq";
     insert_record $db, "odin_pastebin",
@@ -455,6 +466,7 @@ sub update_pastebin ($$\%) {
 
   my $db = open_db;
   my $editp = 0;
+  check_lang $new->{lang};
   xact {
     get_pastebin_check_editkey_or_owner $db, $tag, $editkey, my %old;
     for my $p (@PASTEBIN_PROPS) {
@@ -501,7 +513,7 @@ sub redir_query ($$$;$@) {
 	     ("SELECT lpart, expire, recip, comment
 	       FROM odin_mailredir WHERE dom = ? AND owner = ?" .
 	       (defined $cond ? " AND $cond" : "") . " " .
-	      "ORDER BY expire", undef, $dom, $owner, @args)};
+	      "ORDER BY expire, lpart", undef, $dom, $owner, @args)};
 }
 
 sub clear_redir_reservations ($) {
@@ -550,7 +562,7 @@ sub gen_redir_name ($$) {
   my ($db, $gen) = @_;
 
   for (my $try = 0; $try < $MAIL_MAXGENTRY; $try++) {
-    my $l = $gen->gen;
+    my $l = lc $gen->gen;
     return $l
       unless $db->selectrow_arrayref
 	("SELECT 1 FROM odin_mailredir WHERE lpart = ? AND dom = ?",
@@ -562,7 +574,7 @@ sub gen_redir_name ($$) {
 sub qualify_recip ($) {
   my ($r) = @_;
 
-  return $r =~ /\@/ || !defined $MAIL_QUALDOM ? $r : "$r\@$MAIL_QUALDOM";
+  return $r =~ /\@/ || !defined $MAIL_QUALDOM ? $r : "$r\@\%d";
 }
 
 sub check_fixup_redir ($) {
@@ -574,23 +586,35 @@ sub check_fixup_redir ($) {
   }
 }
 
-sub new_redir ($$\%) {
-  my ($dom, $gen, $r) = @_;
+sub subst_recip ($$) {
+  my ($l, $r) = @_;
+  my %d = ('%' => '%', 'l' => $l, 'd' => $MAIL_QUALDOM);
+  $r =~ s{%([%a-z])}{$d{$1} // fail "undefined substitution `\%$1'"}eg;
+  return $r;
+}
+
+sub new_redir ($$\%;$) {
+  my ($dom, $gen, $r, $n) = @_;
   my $db = open_db;
-  my $l;
+  my @l;
 
+  $n //= 1;
   check_fixup_redir $r;
   Odin::xact {
     clear_redir_reservations $db;
-    $l = Odin::gen_redir_name $db, $gen;
-    insert_record $db, "odin_mailredir",
-      lpart => $l, dom => $dom, owner => $WHO, st => 'live',
-      recip => $r->{recip} // qualify_recip $Odin::WHO,
-      expire => $r->{expire} // -1,
-      comment => $r->{comment} // "";
+    while (@l < $n) {
+      my $l = Odin::gen_redir_name $db, $gen;
+      insert_record $db, "odin_mailredir",
+	lpart => $l, dom => $dom, st => 'live',
+	owner => $WHO, creator => $WHO,
+	recip => subst_recip($l, $r->{recip} // qualify_recip $Odin::WHO),
+	expire => $r->{expire} // -1,
+	comment => $r->{comment} // "";
+      push @l, $l;
+    }
     check_redir_limits $db;
   } $db;
-  return $l;
+  return @l;
 }
 
 sub reserve_redir ($$$) {
@@ -604,7 +628,7 @@ sub reserve_redir ($$$) {
     for (my $i = 0; $i < $n; $i++) { push @l, gen_redir_name $db, $gen; }
     for my $l (@l) {
       insert_record $db, "odin_mailredir",
-	lpart => $l, dom => $dom, owner => $WHO,
+	lpart => $l, dom => $dom, owner => $WHO, creator => $WHO,
 	st => 'reserved', expire => $NOW + $MAIL_AGEMAX_RESV;
     }
     check_redir_limits $db;
@@ -657,31 +681,35 @@ sub disable_redir ($$) {
   } $db;
 }
 
-sub modify_redir ($$\%) {
-  my ($dom, $l, $r) = @_;
+sub modify_redir ($\%@) {
+  my ($dom, $r, @l) = @_;
   my $db = open_db;
 
   check_fixup_redir $r;
   Odin::xact {
     clear_redir_reservations $db;
-    my ($recip, $st) = $db->selectrow_array
-      ("SELECT recip, st FROM odin_mailredir
-	WHERE lpart = ? AND dom = ? AND owner = ?", undef,
-       $l, $dom, $WHO);
-    if (!defined $recip) { Odin::fail "unknown local part `$l'"; }
-    elsif ($recip eq "") { $r->{recip} //= qualify_recip $WHO; }
-    if ($st ne "live") { $r->{st} = "live"; $r->{expire} //= -1; }
-    my @var = ();
-    my @val = ();
-    for my $v (keys %$r) {
-      push @var, $v;
-      push @val, $r->{$v};
+    for my $l (@l) {
+      my %r = %$r;
+      my ($recip, $st) = $db->selectrow_array
+	("SELECT recip, st FROM odin_mailredir
+	  WHERE lpart = ? AND dom = ? AND owner = ?", undef,
+	 $l, $dom, $WHO);
+      if (!defined $recip) { Odin::fail "unknown local part `$l'"; }
+      elsif ($recip eq "" || defined $r{recip})
+	{ $r{recip} = subst_recip $l, $r{recip} // qualify_recip $WHO; }
+      if ($st ne "live") { $r{st} = "live"; $r{expire} //= -1; }
+      my @var = ();
+      my @val = ();
+      for my $v (keys %r) {
+	push @var, $v;
+	push @val, $r{$v};
+      }
+      @var or fail "nothing to change";
+      $db->do("UPDATE odin_mailredir SET " .
+	      join(", ", map { "$_ = ?" } @var) . " " .
+	      "WHERE lpart = ? AND dom = ?", undef,
+	      @val, $l, $dom);
     }
-    @var or fail "nothing to change";
-    $db->do("UPDATE odin_mailredir SET " .
-	    join(", ", map { "$_ = ?" } @var) . " " .
-	    "WHERE lpart = ? AND dom = ?", undef,
-	    @val, $l, $dom);
   } $db;
 }
 
@@ -723,6 +751,19 @@ sub arg {
   return $a;
 }
 
+sub intarg {
+  my ($me, $what, $min, $max) = @_;
+  $what //= "option `-$me->{opt}'";
+  defined (my $a = $me->arg) or return undef;
+  if ($a !~ /^[-+]?\d+$/ ||
+      (defined $min && $a < $min) ||
+      (defined $max && $a > $max)) {
+    $me->err("invalid value `$a' for $what");
+    $a = undef;
+  }
+  return $a;
+}
+
 sub rest { return @{$_[0]->{args}}; }
 sub ok { return $_[0]->{ok}; }
 sub bad { $_[0]->{ok} = 0; }