lib/Odin.pm: Provide substitutions on mail recipient addresses.

[odin-cgi] / lib / Odin.pm

diff --git a/lib/Odin.pm b/lib/Odin.pm
index 154fae0b1c9511cde89593cb42cf4cb0bf34fdb7..90f1dc14921c4114211cb31214365a8b29b055d1 100644 (file)
--- a/lib/Odin.pm
+++ b/lib/Odin.pm
@@ -376,6 +376,16 @@ our @PASTEBIN_PROPS = keys %PASTEBIN_DEFAULTS;
 our $PASTEBIN_PROPCOLS = join ", ", @PASTEBIN_PROPS;
 our $PASTEBIN_PROPPLACES = join ", ", map "?", @PASTEBIN_PROPS;
 
 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) = @_;
 
 sub new_pastebin (\%) {
   my ($new) = @_;
 


@@ -384,6 +394,7 @@ sub new_pastebin (\%) {
   my $tag;
 
   merge_hash %$new, %PASTEBIN_DEFAULTS;
   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",
   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;
 
   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) {
   xact {
     get_pastebin_check_editkey_or_owner $db, $tag, $editkey, my %old;
     for my $p (@PASTEBIN_PROPS) {


@@ -562,7 +574,7 @@ sub gen_redir_name ($$) {
 sub qualify_recip ($) {
   my ($r) = @_;
 
 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 ($) {
 }
 
 sub check_fixup_redir ($) {


@@ -574,6 +586,13 @@ sub check_fixup_redir ($) {
   }
 }
 
   }
 }
 

+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;
 sub new_redir ($$\%;$) {
   my ($dom, $gen, $r, $n) = @_;
   my $db = open_db;


@@ -588,7 +607,7 @@ sub new_redir ($$\%;$) {
       insert_record $db, "odin_mailredir",
        lpart => $l, dom => $dom, st => 'live',
        owner => $WHO, creator => $WHO,
       insert_record $db, "odin_mailredir",
        lpart => $l, dom => $dom, st => 'live',
        owner => $WHO, creator => $WHO,

-       recip => $r->{recip} // qualify_recip $Odin::WHO,
+       recip => subst_recip($l, $r->{recip} // qualify_recip $Odin::WHO),

        expire => $r->{expire} // -1,
        comment => $r->{comment} // "";
       push @l, $l;
        expire => $r->{expire} // -1,
        comment => $r->{comment} // "";
       push @l, $l;


@@ -609,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",
     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;
        st => 'reserved', expire => $NOW + $MAIL_AGEMAX_RESV;
     }
     check_redir_limits $db;


@@ -676,7 +695,8 @@ sub modify_redir ($\%@) {
          WHERE lpart = ? AND dom = ? AND owner = ?", undef,
         $l, $dom, $WHO);
       if (!defined $recip) { Odin::fail "unknown local part `$l'"; }
          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; }
+      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 = ();
       if ($st ne "live") { $r{st} = "live"; $r{expire} //= -1; }
       my @var = ();
       my @val = ();