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 --------------------------------------------------