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";
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) = @_;
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",
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) {
("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 ($) {
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 = ?",
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 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 ($$$) {
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;
} $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;
}
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; }