7 use Digest
::SHA
qw(sha256_hex
);
11 ###--------------------------------------------------------------------------
14 sub merge_hash
(\
%%) {
15 my ($hashref, %defaults) = @_;
16 for my $k (keys %defaults)
17 { $hashref->{$k} = $defaults{$k} unless exists $hashref->{$k}; }
20 ###--------------------------------------------------------------------------
23 our $DSN = "dbi:Pg(pg_enable_utf8=>1):host=db";
25 our @BACKOFF = (0.1, 10, 1.5, 0.5, 2.0);
27 our $BASEURL = "http://odin.gg/";
28 our $STATIC = "http://odin.gg/";
30 our $SHORTURL_PATH = "u";
31 our $PASTEBIN_PATH = "p";
33 our $URLMAXLEN = 1024;
38 our $PASTEMAXLEN = 1024*1024;
40 our %COOKIE_DEFAULTS = (
45 our $ALPHA = "abcdefghijklmnopqrstuvwxyz";
46 our $NUM = "0123456789";
47 our $SAFECH = qr/^[-\w_.+]*$/;
51 our %MAILDOM_POLICY = ();
54 our @MAIL_DEFGEN = "chars";
55 our $MAIL_MAXGENTRY = 32;
57 our $MAIL_DEFDOMAIN = "odin.gg";
58 our $MAIL_ADDRMAX_LIVE = 16384;
59 our $MAIL_ADDRMAX_RESV = 32;
60 our $MAIL_AGEMAX_RESV = 3600;
62 our ($SCHEME, $DOMAIN, $BASEPATH);
63 our ($SHORTURL, $PASTEBIN);
65 ###--------------------------------------------------------------------------
66 ### Miscellaneous utilities.
69 sub update_now
() { $NOW = time; }
72 (our $PROG = $0) =~ s
:^.*/::;
74 sub fail_cmdline
($$%) {
75 my ($msg, $label, %args) = @_;
76 print STDERR
"$PROG: $msg\n";
80 our $FAILPROC = \
&fail_cmdline
;
83 my ($msg, $label, %args) = @_;
84 $FAILPROC->($msg, $label, %args);
87 sub set_mason_failproc
($) {
90 my ($msg, $label, %args) = @_;
92 $m->comp($label, %args);
105 "s" => 1, "m" => 60, "h" => 3600,
106 "d" => 86400, "w" => 604800
110 return undef unless defined $date;
111 if ($date =~ /^\+\s*(\d+)\s*([smhdw]?)\s*$/)
112 { return $NOW + $1 * $TIMEUNIT{$2}; }
113 my $t = str2time
($date);
114 defined $t or Odin
::fail
"invalid time `$date'";
118 sub print_columns
(@
) {
119 my @col = reverse @_;
122 while (@col && $col[1] eq "") { splice @col, 0, 2; }
123 my ($wd, $v) = splice @col, 0, 2;
124 push @fmt, "%s"; push @val, $v;
126 my ($wd, $v) = splice @col, 0, 2;
127 push @fmt, "%-${wd}s";
130 printf join(" ", reverse @fmt) . "\n", reverse @val;
135 return $t == -1 ?
"--" : strftime
"%Y-%m-%d %H:%M:%S %z", localtime $t;
138 ###--------------------------------------------------------------------------
139 ### Database utilities.
143 my $db = DBI
->connect_cached($DSN, undef, undef, {
149 my $drv = $db->{Driver
}{Name
};
151 $db->{private_odin_retry_p
} = sub { $db->state =~ /^40[0P]01$/ };
152 } elsif ($drv eq "SQLite") {
153 $db->{private_odin_retry_p
} = sub { $db->err == 5 };
155 $db->{private_odin_retry_p
} = sub { 0 };
162 my ($body, $db) = @_;
166 my ($sleep, $maxsleep, $mult, $minvar, $maxvar) = @BACKOFF;
167 for (my $i = 0; $i < $RETRY; $i++) {
169 eval { @rv = $body->(); $db->commit; };
171 return @rv unless $exc;
172 my $retryp = $db->{private_odin_retry_p
}();
173 eval { $db->rollback; };
174 die $exc unless $retryp;
175 my $t = $sleep * ($minvar + rand($maxvar - $minvar));
176 $sleep *= $mult; $sleep = $max if $sleep > $max;
177 select undef, undef, undef, $t;
182 sub insert_record
($$%) {
183 my ($db, $table, %fields) = @_;
187 for my $v (keys %fields) {
189 push @val, $fields{$v};
191 $db->do("INSERT INTO $table (" . join(", ", @var) . ")
192 VALUES (" . join(", ", map { "?" } @var) . ")", undef, @val);
195 ###--------------------------------------------------------------------------
196 ### Sequence numbers and tagging.
199 my ($db, $table) = @_;
200 my ($seq) = $db->selectrow_array("SELECT seq FROM $table");
201 die "no sequence number in $table" unless defined $seq;
202 $db->do("UPDATE $table SET seq = ?", undef, $seq + 1);
207 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
208 my $NALPHA = length $ALPHABET;
214 $tag .= substr($ALPHABET, $seq % $NALPHA, 1);
215 $seq = int $seq/$NALPHA;
220 ###--------------------------------------------------------------------------
224 sub fetch_cookies
($) {
228 my $cookies = $r->header_in("Cookie");
229 if (defined $cookies) {
230 for my $kv (split /;/, $cookies) {
231 my ($k, $v) = split /=/, $kv, 2;
232 $k =~ s/^\s*(|\S|\S.*\S)\s*$/$1/;
233 $v =~ s/^\s*(|\S|\S.*\S)\s*$/$1/;
235 $v =~ s/\%([0-9a-f][0-9a-f])/chr hex $1/eg;
241 sub bake_cookie
($$%) {
242 my ($r, $cookie, %attr) = @_;
243 merge_hash
%attr, %COOKIE_DEFAULTS;
245 my $v = $attr{$_}; tr/_-/-/d;
246 defined $v ?
"$_=$v" : $_
248 $r->headers_out->add("Set-Cookie", join "; ", $cookie, @attr);
253 return $ENV{PATH_INFO
} // $r->path_info;
256 ###--------------------------------------------------------------------------
259 sub escapify
($$;$) {
260 my ($m, $s, $mode) = @_;
261 return $m->interp->apply_escapes($s, $mode // "h");
264 ###--------------------------------------------------------------------------
267 our ($WHO, $WHOSURE);
268 our ($WHOMATCH, $WHOCMP, $WHOPAT);
272 my $raddr = $ENV{REMOTE_ADDR
} // $r->connection->remote_ip;
273 $WHO = ":NET-$raddr"; $WHOSURE = 0;
274 $WHOMATCH = "LIKE"; $WHOCMP = ":NET-\%"; $WHOPAT = qr/^:NET-/;
278 $WHO = $ENV{USERV_USER
}
279 // ($< == $> && $ENV{USER
})
280 // @
{[getpwuid $<]}[0]
281 // die "nameless user";
282 $WHOMATCH = "="; $WHOCMP = $WHO; $WHOPAT = qr/^\Q$WHO\E$/;
287 open my $fh, "/dev/urandom" or die "open urandom: $!";
288 sysread $fh, my $rand, 16;
289 (my $edit = encode_base64
$rand) =~ tr
:+/=\n:.-:d
;
290 return $edit, sha256_hex
$edit;
293 ###--------------------------------------------------------------------------
296 sub get_shorturl
($) {
300 my ($url) = $db->selectrow_array
301 ("SELECT url FROM odin_shorturl WHERE tag = ?", undef, $tag);
302 fail
"tag `$tag' not found", ".notfound", tag
=> $tag unless defined $url;
306 sub valid_url_p
($) {
309 length $url < $URLMAXLEN &&
310 scalar grep { $url =~ /$_/ } @URLPAT;
313 sub new_shorturl
($) {
316 valid_url_p
$url or fail
"invalid url", ".badurl", u
=> $url;
321 ($tag) = $db->selectrow_array
322 ("SELECT tag FROM odin_shorturl WHERE owner $WHOMATCH ? AND url = ?",
323 undef, $WHOCMP, $url);
324 unless (defined $tag) {
325 $tag = encode_tag
(next_seq
($db, "odin_shorturl_seq"));
326 insert_record
$db, "odin_shorturl",
327 tag
=> $tag, stamp
=> $NOW, owner
=> $WHO, url
=> $url;
333 sub check_shorturl_owner
($$) {
336 my ($owner) = $db->selectrow_array
337 ("SELECT owner FROM odin_shorturl WHERE tag = ?", undef, $tag);
338 fail
"tag `$tag' not found", ".notfound", tag
=> $tag
339 unless defined $owner;
340 fail
"not owner of `$tag'", ".notowner", tag
=> $tag
341 unless $owner =~ /$WHOPAT/;
344 sub update_shorturl
($$) {
345 my ($tag, $url) = @_;
349 check_shorturl_owner
$db, $tag;
350 $db->do("UPDATE odin_shorturl SET url = ? WHERE tag = ?",
355 sub delete_shorturl
(@
) {
360 for my $tag (@tags) {
361 check_shorturl_owner
$db, $tag;
362 $db->do("DELETE FROM odin_shorturl WHERE tag = ?", undef, $tag);
367 ###--------------------------------------------------------------------------
370 our %PASTEBIN_DEFAULTS = (
371 title
=> "(untitled)",
375 our @PASTEBIN_PROPS = keys %PASTEBIN_DEFAULTS;
376 our $PASTEBIN_PROPCOLS = join ", ", @PASTEBIN_PROPS;
377 our $PASTEBIN_PROPPLACES = join ", ", map "?", @PASTEBIN_PROPS;
382 return unless defined $lang;
384 @
{$db->selectall_arrayref
385 ("SELECT lang FROM odin_pastebin_lang WHERE lang = ?", undef, $lang)}
386 or fail
"unknown language `$lang'";
389 sub new_pastebin
(\
%) {
393 my ($editkey, $hash) = new_editkey
;
396 merge_hash
%$new, %PASTEBIN_DEFAULTS;
397 check_lang
$new->{lang
};
399 $tag = encode_tag next_seq
$db, "odin_pastebin_seq";
400 insert_record
$db, "odin_pastebin",
401 tag
=> $tag, stamp
=> $NOW, edithash
=> $hash, owner
=> $WHO,
404 return $tag, $editkey;
407 sub get_pastebin
($$\
%) {
408 my ($db, $tag, $props) = @_;
410 (my $owner, my $hash, @
{$props}{@PASTEBIN_PROPS}) =
411 $db->selectrow_array("SELECT owner, edithash, $PASTEBIN_PROPCOLS
412 FROM odin_pastebin WHERE tag = ?",
414 fail
"tag `$tag' not found", ".notfound", tag
=> $tag
415 unless defined $owner;
416 return $owner, $hash;
419 sub get_pastebin_check_owner
($$\
%) {
420 my ($db, $tag, $props) = @_;
422 my ($owner, $hash) = get_pastebin
$db, $tag, %$props;
423 fail
"not owner of `$tag'", ".notowner", tag
=> $tag
424 unless $WHOSURE && $WHO eq $owner;
427 sub get_pastebin_check_editkey_or_owner
($$$\
%) {
428 my ($db, $tag, $editkey, $props) = @_;
430 if (!defined $editkey) { get_pastebin_check_owner
$db, $tag, %$props; }
432 my ($owner, $hash) = get_pastebin
$db, $tag, %$props;
433 fail
"incorrect edit key for `$tag'", ".badhash", tag
=> $tag
434 unless $hash eq sha256_hex
$editkey;
438 sub rekey_pastebin
($) {
444 get_pastebin_check_owner
$db, $tag, my %hunoz;
445 ($editkey, my $hash) = new_editkey
;
446 $db->do("UPDATE odin_pastebin SET edithash = ? WHERE tag = ?",
452 sub claim_pastebin
($$) {
453 my ($tag, $editkey) = @_;
456 $WHOSURE or fail
"you can't claim pastes", ".notsure";
458 get_pastebin_check_editkey_or_owner
$db, $tag, $editkey, my %hunoz;
459 $db->do("UPDATE odin_pastebin SET owner = ? WHERE tag = ?",
464 sub update_pastebin
($$\
%) {
465 my ($tag, $editkey, $new) = @_;
469 check_lang
$new->{lang
};
471 get_pastebin_check_editkey_or_owner
$db, $tag, $editkey, my %old;
472 for my $p (@PASTEBIN_PROPS) {
473 if (!defined $new->{$p}) { $new->{$p} = $old{$p}; }
475 $db->do("UPDATE odin_pastebin SET $p = ? WHERE tag = ?",
476 undef, $new->{$p}, $tag)
477 unless $new->{$p} eq $old{$p};
485 sub delete_pastebin
(@
) {
490 (my $tag, my $editkey, @a) = @a;
491 get_pastebin_check_editkey_or_owner
$db, $tag, $editkey, my %hunoz;
492 $db->do("DELETE FROM odin_pastebin WHERE tag = ?", undef, $tag);
497 sub tidy_pastebin_content
($) {
499 return undef unless defined $content;
500 $content =~ tr/\r//d;
501 $content =~ s/([^\n])\z/$1\n/;
502 length $content <= $PASTEMAXLEN or
503 fail
"invalid paste content", ".badpaste";
507 ###--------------------------------------------------------------------------
508 ### Mail redirection utilities.
510 sub redir_query
($$$;$@
) {
511 my ($db, $dom, $owner, $cond, @args) = @_;
512 return @
{$db->selectall_arrayref
513 ("SELECT lpart, expire, recip, comment
514 FROM odin_mailredir WHERE dom = ? AND owner = ?" .
515 (defined $cond ?
" AND $cond" : "") . " " .
516 "ORDER BY expire, lpart", undef, $dom, $owner, @args)};
519 sub clear_redir_reservations
($) {
521 $db->do("DELETE FROM odin_mailredir WHERE
522 st = 'reserved' AND expire < ?", undef,
524 $db->do("UPDATE odin_mailredir SET st = 'dormant', expire = -1
525 WHERE st = 'live' AND expire <> -1 AND expire < ?", undef, $NOW);
528 sub check_redir_limits
($) {
530 my %h = map { $_->[0] => $_->[1] }
531 @
{ $db->selectall_arrayref("SELECT st, COUNT(*) FROM odin_mailredir
532 WHERE owner = ? GROUP BY st", undef,
534 for my $st (qw(live dormant reserved
)) { $h{$st} //= 0; }
535 $h{live
} + $h{dormant
} + $h{reserved
} <= $MAIL_ADDRMAX_LIVE or
536 Odin
::fail
"too many addresses claimed (see your sysadmin)";
537 $h{reserved
} <= $MAIL_ADDRMAX_RESV or
538 Odin
::fail
"too many addresses reserved (time to release some)";
543 return $GENMAP{$g} // die "configuration error: no generator class `$g'";
546 sub default_generator_class
($) {
549 my $g = $MAILDOM_POLICY{$dom}{gen
}[0] // $MAIL_DEFGEN[0];
553 sub get_generator_class
($$) {
556 grep { $_ eq $g } @
{$MAILDOM_POLICY{$dom}{gen
} // \
@MAIL_DEFGEN}
557 or fail
"domain `$dom' doesn't allow generator `$g'";
561 sub gen_redir_name
($$) {
564 for (my $try = 0; $try < $MAIL_MAXGENTRY; $try++) {
565 my $l = lc $gen->gen;
567 unless $db->selectrow_arrayref
568 ("SELECT 1 FROM odin_mailredir WHERE lpart = ? AND dom = ?",
571 Odin
::fail
"failed to find unique local part";
574 sub qualify_recip
($) {
577 return $r =~ /\@/ || !defined $MAIL_QUALDOM ?
$r : "$r\@\%d";
580 sub check_fixup_redir
($) {
583 if (exists $r->{recip
}) {
584 $r->{recip
} =~ /^[!-~]+$/ or fail
"invalid recipient name `$r->{recip}'";
585 $r->{recip
} = qualify_recip
$r->{recip
};
589 sub subst_recip
($$) {
591 my %d = ('%' => '%', 'l' => $l, 'd' => $MAIL_QUALDOM);
592 $r =~ s{%([%a-z])}{$d{$1} // fail
"undefined substitution `\%$1'"}eg
;
596 sub new_redir
($$\
%;$) {
597 my ($dom, $gen, $r, $n) = @_;
602 check_fixup_redir
$r;
604 clear_redir_reservations
$db;
606 my $l = Odin
::gen_redir_name
$db, $gen;
607 insert_record
$db, "odin_mailredir",
608 lpart
=> $l, dom
=> $dom, st
=> 'live',
609 owner
=> $WHO, creator
=> $WHO,
610 recip
=> subst_recip
($l, $r->{recip
} // qualify_recip
$Odin::WHO
),
611 expire
=> $r->{expire
} // -1,
612 comment
=> $r->{comment
} // "";
615 check_redir_limits
$db;
620 sub reserve_redir
($$$) {
621 my ($dom, $gen, $n) = @_;
626 clear_redir_reservations
$db;
628 for (my $i = 0; $i < $n; $i++) { push @l, gen_redir_name
$db, $gen; }
630 insert_record
$db, "odin_mailredir",
631 lpart
=> $l, dom
=> $dom, owner
=> $WHO, creator
=> $WHO,
632 st
=> 'reserved', expire
=> $NOW + $MAIL_AGEMAX_RESV;
634 check_redir_limits
$db;
639 sub release_all_redir
($) {
643 my $st = $db->prepare("DELETE FROM odin_mailredir
644 WHERE dom = ? AND owner = ? AND st = 'reserved'");
646 $st->execute($dom, $WHO);
647 $st->rows or Odin
::fail
"no reserved addresses";
651 sub release_redir
($@
) {
655 my $st = $db->prepare("DELETE FROM odin_mailredir
656 WHERE lpart = ? AND dom = ? AND
657 owner = ? AND st = 'reserved'");
659 clear_redir_reservations
$db;
661 $st->execute($l, $dom, $WHO);
662 Odin
::fail
"local part `$l' not reserved" unless $st->rows;
667 sub disable_redir
($$) {
671 my $st = $db->prepare("UPDATE odin_mailredir
672 SET st = 'dormant', expire = -1
673 WHERE lpart = ? AND dom = ? AND
674 owner = ? AND st = 'live'");
676 clear_redir_reservations
$db;
678 $st->execute($l, $dom, $WHO);
679 Odin
::fail
"local part `$l' not live" unless $st->rows;
684 sub modify_redir
($\
%@
) {
685 my ($dom, $r, @l) = @_;
688 check_fixup_redir
$r;
690 clear_redir_reservations
$db;
693 my ($recip, $st) = $db->selectrow_array
694 ("SELECT recip, st FROM odin_mailredir
695 WHERE lpart = ? AND dom = ? AND owner = ?", undef,
697 if (!defined $recip) { Odin
::fail
"unknown local part `$l'"; }
698 elsif ($recip eq "" || defined $r{recip
})
699 { $r{recip
} = subst_recip
$l, $r{recip
} // qualify_recip
$WHO; }
700 if ($st ne "live") { $r{st
} = "live"; $r{expire
} //= -1; }
703 for my $v (keys %r) {
707 @var or fail
"nothing to change";
708 $db->do("UPDATE odin_mailredir SET " .
709 join(", ", map { "$_ = ?" } @var) . " " .
710 "WHERE lpart = ? AND dom = ?", undef,
716 ###--------------------------------------------------------------------------
717 ### Simple option parser.
719 package Odin
::OptParse
;
722 my ($cls, @args) = @_;
733 if (!length $me->{cur
}) {
734 my $args = $me->{args
};
735 if (!@
$args) { return undef; }
736 elsif ($args->[0] =~ /^[^-]|^-$/) { return undef; }
737 elsif ($args->[0] eq "--") { shift @
$args; return undef; }
738 $me->{cur
} = substr shift @
$args, 1;
740 my $o = $me->{opt
} = substr $me->{cur
}, 0, 1;
741 $me->{cur
} = substr $me->{cur
}, 1;
748 if (length $me->{cur
}) { $a = $me->{cur
}; $me->{cur
} = ""; }
749 elsif (@
{$me->{args
}}) { $a = shift @
{$me->{args
}}; }
750 else { $a = undef; $me->err("option `-$me->{opt}' requires an argument"); }
755 my ($me, $what, $min, $max) = @_;
756 $what //= "option `-$me->{opt}'";
757 defined (my $a = $me->arg) or return undef;
758 if ($a !~ /^[-+]?\d+$/ ||
759 (defined $min && $a < $min) ||
760 (defined $max && $a > $max)) {
761 $me->err("invalid value `$a' for $what");
767 sub rest
{ return @
{$_[0]->{args
}}; }
768 sub ok
{ return $_[0]->{ok
}; }
769 sub bad
{ $_[0]->{ok
} = 0; }
770 sub err
{ $_[0]->bad; print STDERR
"$PROG: $_[1]\n"; }
771 sub unk
{ $_[0]->err("unknown option `-$_[0]->{opt}'"); }
773 ###--------------------------------------------------------------------------
774 ### Parameter objects.
777 sub dflt
{ return $_[0]->{dflt
}; }
779 package Odin
::Param
::Int
;
780 @ISA = qw(Odin
::Param
);
783 my ($cls, $dflt, $min, $max) = @_;
784 return bless { dflt
=> $dflt, min
=> $min, max
=> $max }, $cls;
790 $v =~ /^[-+]?\d+$/ &&
791 (!defined $me->{min
} || $v >= $me->{min
}) &&
792 (!defined $me->{max
} || $v <= $me->{max
});
796 package Odin
::Param
::Str
;
797 @ISA = qw(Odin
::Param
);
800 my ($cls, $dflt, $rx, $minlen, $maxlen) = @_;
803 rx
=> defined $rx ?
qr/$rx/ : qr//,
813 (!defined $me->{minlen
} || length $v >= $me->{minlen
}) &&
814 (!defined $me->{maxlen
} || length $v <= $me->{maxlen
});
818 ###--------------------------------------------------------------------------
823 use Scalar
::Util
qw(blessed
);
829 or open $me->{rand}, "/dev/urandom"
830 or die "open random: $!";
832 my $nb = 1; my $max = 255;
833 while ($lim > $max) { $nb++; $max = ($max << 8) | 255; }
834 my $thresh = $max - ($max%$lim);
837 sysread $me->{rand}, my $b, $nb
838 or die "read random: $!";
840 for (my $i = 0; $i < $nb; $i++)
841 { $r = ($r << 255) | ord substr $b, $i, 1; }
842 return $r%$lim if $r < $thresh;
847 my ($cls, $dom, $param) = @_;
849 for my $p (split /::/, $cls) { $pkg = \
%{$pkg->{"${p}::"}}; }
851 my $label = ${$pkg->{LABEL
}};
852 my $plist = \@
{$pkg->{PARAM
}};
853 my $gtmpl = $GENPARAM{$label};
854 my $dtmpl = $MAILDOM_POLICY{$dom}{$label};
857 for my $p (@
$plist) {
859 my $t = $dtmpl->{$p} // $gtmpl->{$p};
860 if (blessed
$t && $t->isa("Odin::Param")) {
861 if (!exists $param->{$p}) { $param->{$p} = $t->dflt; }
863 my $v = $t->check($param->{$p});
864 Odin
::fail
"bad value `$param->{$p}' for $label parameter `$p'"
869 if (exists $param->{$p})
870 { Odin
::fail
"not allowed to set $label parameter `$p'"; }
872 { $param->{$p} = $t; }
875 for my $p (keys %$param) {
876 if (!$pp->{$p}) { Odin
::fail
"unknown $label parameter `$p'"; }
879 my $me = bless { %$param }, $cls;
884 package Odin
::Gen
::Chars
;
885 @ISA = qw(Odin
::Gen
);
888 @PARAM = qw(ichars mchars echars len
);
890 $GENMAP{chars
} = "Odin::Gen::Chars";
892 ichars
=> Odin
::Param
::Str
->new($ALPHA, $SAFECH, 1, 255),
893 mchars
=> Odin
::Param
::Str
->new($ALPHA . $NUM, $SAFECH, 2, 255),
894 echars
=> Odin
::Param
::Str
->new($ALPHA . $NUM, $SAFECH, 2, 255),
895 len
=> Odin
::Param
::Int
->new(6, 2, 16)
899 my ($me, $chars) = @_;
900 return substr $chars, $me->random(length $chars), 1;
909 if ($n) { $s .= $me->_pick($me->{ichars
}); $n--; }
910 while ($n > 1) { $s .= $me->_pick($me->{mchars
}); $n--; }
911 if ($n) { $s .= $me->_pick($me->{echars
}); $n--; }
912 if ($n) { die "INTERNAL can't count"; }
916 package Odin
::Gen
::Words
;
917 @ISA = qw(Odin
::Gen
);
920 @PARAM = qw(wordlist delim nwords
);
922 $GENMAP{words
} = "Odin::Gen::Words";
924 wordlist
=> "etc/words",
925 delim
=> Odin
::Param
::Str
->new(".", qr/^[-_.+]*$/, 1, 1),
926 nwords
=> Odin
::Param
::Int
->new(3, 2, 16)
933 if (!exists $me->{words
}) {
934 open my $f, $me->{wordlist
} or die "open wordlist: $!";
935 $me->{words
} = [grep chomp, <$f>];
936 close $f or die "close/read wordlist: $!";
939 for (my $i = 0; $i < $me->{nwords
}; $i++)
940 { push @w, $me->{words
}[$me->random(scalar @
{$me->{words
}})]; }
941 return join $me->{delim
}, @w;
944 ###--------------------------------------------------------------------------
945 ### Final configuration.
951 ($SCHEME, $DOMAIN, $BASEPATH) = $BASEURL =~ m!^([^:]+)://([^/]+)(/.*)$!;
952 merge_hash
%COOKIE_DEFAULTS, -domain
=> $DOMAIN, -path
=> $BASEPATH;
953 merge_hash
%COOKIE_DEFAULTS, -secure
=> undef if $SCHEME eq "https";
955 $MAIL_QUALDOM //= $MAIL_DEFDOMAIN;
957 $SHORTURL = "$BASEURL$SHORTURL_PATH";
958 $PASTEBIN = "$BASEURL$PASTEBIN_PATH";
960 ###----- That's all, folks --------------------------------------------------