X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=cgi-auth-flexible.pm;h=e8b493dbcbeed9920cab70c0548b42328d73c3b1;hp=e5b89244476da131f03615daf19a367b6c12c0ac;hb=ac57fc9f2d0e7f51609bb85c7691a3bcaab74322;hpb=031ab04359164ef2e3d311e61637491479e6098d diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm index e5b8924..e8b493d 100644 --- a/cgi-auth-flexible.pm +++ b/cgi-auth-flexible.pm @@ -18,7 +18,7 @@ # along with this program. If not, see . use strict; -use warnings; +use warnings FATAL => 'all'; package CGI::Auth::Flexible; require Exporter; @@ -32,7 +32,7 @@ BEGIN { @EXPORT = qw(); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - @EXPORT_OK = qw(setup); + @EXPORT_OK = qw(); } our @EXPORT_OK; @@ -54,6 +54,7 @@ sub flatten_params ($) { my ($p) = @_; my @p; foreach my $k (keys %$p) { + next if $k eq ''; foreach my $v (@{ $p->{$k} }) { push @p, $k, $v; } @@ -92,7 +93,8 @@ sub login_ok_password ($$) { my $username_params = $r->{S}{username_param_names}; my $username = $r->_ch('get_param',$username_params->[0]); my $password = $r->_rp('password_param_name'); - return $r->_ch('username_password_ok', $username, $password); + my $error = $r->_ch('username_password_error', $username, $password); + return defined($error) ? (undef,$error) : ($username,undef); } sub do_redirect_cgi ($$$$) { @@ -104,39 +106,66 @@ sub do_redirect_cgi ($$$$) { '', $r->_gt("If you aren't redirected, click to continue."), "", - $c->_ch('gen_end_html')); + $r->_ch('gen_end_html')); } -sub gen_plain_login_form ($$) { - my ($c,$r, $params) = @_; +sub gen_some_form ($$) { + my ($r, $params, $bodyfn) = @_; + # Calls $bodyfn->($c,$r) which returns @formbits + my $c = $r->{Cgi}; my @form; + my $pathinfo = ''; + $pathinfo .= $params->{''}[0] if $params->{''}; push @form, ('
'. - ''); - my $sz = 'size="'.$r->{S}{form_entry_size}.'"'; - foreach my $up (@{ $r->{S}{username_param_names}}) { - push @form, ('', - ''); - } - push @form, ('', - ''); - push @form, ('', - '
',$r->_gt(ucfirst $up),'
'.$r->_gt('Password').'
', - '
'); + escapeHTML($r->_ch('get_url').$pathinfo).'">'); + push @form, $bodyfn->($c,$r); foreach my $n (keys %$params) { - push @form, (''); + next if $n eq ''; + foreach my $val (@{ $params->{$n} }) { + push @form, (''); + } } push @form, ('
'); return join "\n", @form; } -sub gen_login_link ($$) { +sub gen_plain_login_form ($$) { + my ($c,$r, $params) = @_; + return $r->gen_some_form($params, sub { + my @form; + push @form, (''); + my $sz = 'size="'.$r->{S}{form_entry_size}.'"'; + foreach my $up (@{ $r->{S}{username_param_names}}) { + push @form, ('', + ''); + } + push @form, ('', + ''); + push @form, ('', + '
',$r->_gt(ucfirst $up),'
'.$r->_gt('Password').'
', + '
'); + return @form; + }); +} + +sub gen_postmainpage_form ($$$) { + my ($c,$r, $params) = @_; + return $r->gen_some_form($params, sub { + my @form; + push @form, (''); + return @form; + }); +} + +sub gen_plain_login_link ($$) { my ($c,$r, $params) = @_; my $url = $r->url_with_query_params($params); return (''. @@ -151,6 +180,7 @@ sub new_verifier { my $verifier = { S => { dir => undef, + assocdb_dbh => undef, # must have AutoCommit=0, RaiseError=1 assocdb_path => 'caf-assocs.db', keys_path => 'caf-keys', assocdb_dsn => undef, @@ -164,22 +194,23 @@ sub new_verifier { login_form_timeout => 3600, # seconds key_rollover => 86400, # seconds assoc_param_name => 'caf_assochash', + dummy_param_name_prefix => 'caf__', cookie_name => "caf_assocsecret", password_param_name => 'password', username_param_names => [qw(username)], form_entry_size => 60, logout_param_names => [qw(caf_logout)], - login_submit_name => [qw(caf_login)], loggedout_param_names => [qw(caf_loggedout)], promise_check_mutate => 0, get_param => sub { $_[0]->param($_[2]) }, get_params => sub { $_[1]->get_params() }, + get_path_info => sub { $_[0]->path_info() }, get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) }, get_method => sub { $_[0]->request_method() }, get_url => sub { $_[0]->url(); }, is_login => sub { defined $_[1]->_rp('password_param_name') }, login_ok => \&login_ok_password, - username_password_ok => sub { die }, + username_password_error => sub { die }, is_logout => sub { $_[1]->has_a_param('logout_param_names') }, is_loggedout => sub { $_[1]->has_a_param('loggedout_param_names') }, is_page => sub { return 1 }, @@ -192,6 +223,7 @@ sub new_verifier { gen_end_html => sub { $_[0]->end_html(); }, gen_login_form => \&gen_plain_login_form, gen_login_link => \&gen_plain_login_link, + gen_postmainpage_form => \&gen_postmainpage_form, gettext => sub { gettext($_[2]); }, print => sub { print $_[2] or die $!; }, }, @@ -223,17 +255,23 @@ sub _dbopen ($) { my $dbh = $v->{Dbh}; return $dbh if $dbh; - $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=".$v->_get_path('assocdb'); - my $dsn = $v->{S}{assocdb_dsn}; - - my $u = umask 077; - $dbh = DBI->connect($dsn, $v->{S}{assocdb_user}, - $v->{S}{assocdb_password}, { - AutoCommit => 0, - RaiseError => 1, - ShowErrorStatement => 1, - }); - die "$dsn $! ?" unless $dbh; + $dbh = $v->{S}{assocdb_dbh}; + if ($dbh) { + die if $dbh->{AutoCommit}; + die unless $dbh->{RaiseError}; + } else { + $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=".$v->_get_path('assocdb'); + my $dsn = $v->{S}{assocdb_dsn}; + + my $u = umask 077; + $dbh = DBI->connect($dsn, $v->{S}{assocdb_user}, + $v->{S}{assocdb_password}, { + AutoCommit => 0, + RaiseError => 1, + ShowErrorStatement => 1, + }); + die "$dsn $! ?" unless $dbh; + } $v->{Dbh} = $dbh; $v->_db_setup_do("CREATE TABLE $v->{S}{assocdb_table} (". @@ -259,31 +297,31 @@ sub _db_transaction ($$) { my $retries = 10; my $rv; my $dbh = $v->{Dbh}; -print STDERR "DT entry\n"; +#print STDERR "DT entry\n"; for (;;) { -print STDERR "DT loop\n"; +#print STDERR "DT loop\n"; if (!eval { $rv = $fn->(); -print STDERR "DT fn ok\n"; +#print STDERR "DT fn ok\n"; 1; }) { -print STDERR "DT fn error\n"; +#print STDERR "DT fn error\n"; { local ($@); $dbh->rollback(); } -print STDERR "DT fn throwing\n"; +#print STDERR "DT fn throwing\n"; die $@; } -print STDERR "DT fn eval ok\n"; +#print STDERR "DT fn eval ok\n"; if (eval { $dbh->commit(); -print STDERR "DT commit ok\n"; +#print STDERR "DT commit ok\n"; 1; }) { -print STDERR "DT commit eval ok $rv\n"; +#print STDERR "DT commit eval ok ",Dumper($rv); return $rv; } -print STDERR "DT commit throw?\n"; +#print STDERR "DT commit throw?\n"; die $@ if !--$retries; -print STDERR "DT loop again\n"; +#print STDERR "DT loop again\n"; } } @@ -341,7 +379,7 @@ my @ca = (-name => $r->{S}{cookie_name}, -expires => '+'.$r->{S}{login_timeout}.'s', -secure => $r->{S}{encrypted_only}); my $cookie = $c->cookie(@ca); -print STDERR "CC $r $c $cooks $cookie (@ca).\n"; +#print STDERR "CC $r $c $cooks $cookie (@ca).\n"; return $cookie; } @@ -464,9 +502,11 @@ sub _check_divert_core ($) { my $cookh = defined $cooks ? $r->hash($cooks) : undef; my ($cookt,$cooku) = $r->_identify($cookh, $cooks); - my $parmt = $r->_identify($parmh, undef); + my $parms = (defined $cooks && defined $parmh && $parmh eq $cookh) + ? $cooks : undef; + my ($parmt) = $r->_identify($parmh, $parms); - print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n"; +#print STDERR "_c_d_c cookt=$cookt parmt=$parmt\n"; if ($r->_ch('is_logout')) { $r->_must_be_post(); @@ -474,7 +514,7 @@ sub _check_divert_core ($) { $r->_db_revoke($cookh); $r->_db_revoke($parmh); return ({ Kind => 'REDIRECT-LOGGEDOUT', - Message => "Logging out...", + Message => $r->_gt("Logging out..."), CookieSecret => '', Params => { } }); } @@ -483,7 +523,7 @@ sub _check_divert_core ($) { die unless $cookt; die unless $parmt; return ({ Kind => 'SMALLPAGE-LOGGEDOUT', - Message => "You have been logged out.", + Message => $r->_gt("You have been logged out."), CookieSecret => '', Params => { } }); } @@ -492,31 +532,35 @@ sub _check_divert_core ($) { die unless $parmt; if (!$cookt && $parmt eq 't') { return ({ Kind => 'SMALLPAGE-NOCOOKIE', - Message => "You do not seem to have cookies enabled. ". - "You must enable cookies as we use them for login.", - CookieSecret => $r->_fresh_secret(), - Params => $r->_chain_params() }) + Message => $r->_gt("You do not seem to have cookies". + " enabled. You must enable cookies". + " as we use them for login."), + CookieSecret => $r->_fresh_secret(), + Params => $r->chain_params() }) } if (!$cookt || $cookt eq 'n' || $cookh ne $parmh) { $r->_db_revoke($cookh); return ({ Kind => 'LOGIN-STALE', - Message => "Stale session; you need to log in again.", + Message => $r->_gt("Stale session;". + " you need to log in again."), CookieSecret => $r->_fresh_secret(), Params => { } }) } die unless $parmt eq 't' || $parmt eq 'y'; - my $username = $r->_ch('login_ok'); + my ($username, $login_errormessage) = $r->_ch('login_ok'); unless (defined $username && length $username) { + $login_errormessage = $r->_gt("Incorrect username/password.") + if !$login_errormessage; return ({ Kind => 'LOGIN-BAD', - Message => "Incorrect username/password.", + Message => $login_errormessage, CookieSecret => $cooks, - Params => $r->_chain_params() }) + Params => $r->chain_params() }) } $r->_db_record_login_ok($parmh,$username); return ({ Kind => 'REDIRECT-LOGGEDIN', - Message => "Logging in...", + Message => $r->_gt("Logging in..."), CookieSecret => $cooks, - Params => $r->_chain_params() }); + Params => $r->chain_params() }); } if ($cookt eq 't') { $cookt = ''; @@ -534,13 +578,13 @@ sub _check_divert_core ($) { my $news = $r->_fresh_secret(); if ($meth eq 'GET') { return ({ Kind => 'LOGIN-INCOMINGLINK', - Message => "You need to log in again.", + Message => $r->_gt("You need to log in."), CookieSecret => $news, - Params => $r->_chain_params() }); + Params => $r->chain_params() }); } else { $r->_db_revoke($parmh); return ({ Kind => 'LOGIN-FRESH', - Message => "You need to log in again.", + Message => $r->_gt("You need to log in."), CookieSecret => $news, Params => { } }); } @@ -549,7 +593,7 @@ sub _check_divert_core ($) { if (!$r->{S}{promise_check_mutate}) { if ($meth ne 'POST') { return ({ Kind => 'MAINPAGEONLY', - Message => 'Entering via cross-site link.', + Message => $r->_gt('Entering via cross-site link.'), CookieSecret => $cooks, Params => { } }); # NB caller must then ignore params & path! @@ -559,15 +603,17 @@ sub _check_divert_core ($) { } die unless $cookt eq 'y'; - die unless $parmt eq 'y'; - die unless $cookh eq $parmh; + unless ($r->{S}{promise_check_mutate} && $meth eq 'GET') { + die unless $parmt eq 'y'; + die unless $cookh eq $parmh; + } $r->{AssocSecret} = $cooks; $r->{UserOK} = $cooku; - print STDERR "C-D-C OK\n"; +#print STDERR "C-D-C OK\n"; return undef; } -sub _chain_params ($) { +sub chain_params ($) { my ($r) = @_; my %p = %{ $r->_ch('get_params') }; foreach my $pncn (keys %{ $r->{S} }) { @@ -585,6 +631,12 @@ sub _chain_params ($) { delete $p{$name}; } } + my $dummy_prefix = $r->{S}{dummy_param_name_prefix}; + foreach my $name (grep /^$dummy_prefix/, keys %p) { + delete $p{$name}; + } + die if exists $p{''}; + $p{''} = [ $r->_ch('get_path_info') ]; return \%p; } @@ -594,7 +646,9 @@ sub _identify ($$) { # where $t is one of "t" "y" "n", or "" (for -) # either $s must be undef, or $h eq $r->hash($s) +#print STDERR "_identify\n"; return '' unless defined $h && length $h; +#print STDERR "_identify h=$h s=".(defined $s ? $s : '')."\n"; my $dbh = $r->{Dbh}; @@ -606,6 +660,7 @@ sub _identify ($$) { " FROM $r->{S}{assocdb_table}". " WHERE assochash = ?", {}, $h); if (defined $row) { +#print STDERR "_identify h=$h s=$s YES @$row\n"; my ($nusername, $nlast) = @$row; return ('y', $nusername); } @@ -618,15 +673,20 @@ sub _identify ($$) { my ($keyt, $signature, $message, $noncet, $nonce) = $s =~ m/^(\d+)\.(\w+)\.((\d+)\.(\w+))$/ or die; - return 'n' if time > $noncet + $r->{S}{form_timeout}; + return 'n' if time > $noncet + $r->{S}{login_form_timeout}; + +#print STDERR "_identify noncet=$noncet ok\n"; my $keys = $r->_open_keys(); while (my ($rkeyt, $rkey, $line) = $r->_read_key($keys)) { +#print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey\n"; last if $rkeyt < $keyt; # too far down in the file my $trysignature = $r->_hmac($rkey, $message); +#print STDERR "_identify search rkeyt=$rkeyt rkey=$rkey try=$trysignature\n"; return 't' if $trysignature eq $signature; } # oh well +#print STDERR "_identify NO\n"; $keys->error and die $!; return 'n'; @@ -647,7 +707,7 @@ sub _db_record_login_ok ($$$) { $r->_db_revoke($h); my $dbh = $r->{Dbh}; $dbh->do("INSERT INTO $r->{S}{assocdb_table}". - " (associd, username, last) VALUES (?,?,?)", {}, + " (assochash, username, last) VALUES (?,?,?)", {}, $h, $user, time); } @@ -659,7 +719,7 @@ sub check_divert ($) { my $dbh = $r->{Dbh}; $r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); }); $dbh->commit(); - print STDERR Dumper($r->{Divert}); +#print STDERR Dumper($r->{Divert}); return $r->{Divert}; } @@ -678,7 +738,9 @@ sub get_username ($) { sub url_with_query_params ($$) { my ($r, $params) = @_; +#print STDERR "PARAMS ",Dumper($params); my $uri = URI->new($r->_ch('get_url')); + $uri->path($uri->path() . $params->{''}[0]) if $params->{''}; $uri->query_form(flatten_params($params)); return $uri->as_string(); } @@ -687,7 +749,7 @@ sub _cgi_header_args ($$@) { my ($r, $cookie, @ha) = @_; unshift @ha, qw(-type text/html); push @ha, (-cookie => $cookie) if defined $cookie; - print STDERR "_cgi_header_args ",join('|',@ha),".\n"; +#print STDERR "_cgi_header_args ",join('|',@ha),".\n"; return @ha; } @@ -705,17 +767,13 @@ sub check_ok ($) { my $params = $divert->{Params}; my $cookie = $r->construct_cookie($cookiesecret); - if (defined $cookiesecret) { - $params->{$r->{S}{assoc_param_name}} = $r->hash($cookiesecret); - } - if ($kind =~ m/^REDIRECT-/) { # for redirects, we honour stored NextParams and SetCookie, # as we would for non-divert if ($kind eq 'REDIRECT-LOGGEDOUT') { - $params->{$r->{S}{loggedout_param_names}[0]} = 1; + $params->{$r->{S}{loggedout_param_names}[0]} = [ 1 ]; } elsif ($kind eq 'REDIRECT-LOGOUT') { - $params->{$r->{S}{logout_param_names}[0]} = 1; + $params->{$r->{S}{logout_param_names}[0]} = [ 1 ]; } elsif ($kind eq 'REDIRECT-LOGGEDIN') { } else { die; @@ -725,15 +783,23 @@ sub check_ok ($) { return 0; } + if (defined $cookiesecret) { + $params->{$r->{S}{assoc_param_name}} = [ $r->hash($cookiesecret) ]; + } + my ($title, @body); if ($kind =~ m/^LOGIN-/) { $title = $r->_gt('Login'); - push @body, $r->_gt($divert->{Message}); + push @body, $divert->{Message}; push @body, $r->_ch('gen_login_form', $params); } elsif ($kind =~ m/^SMALLPAGE-/) { $title = $r->_gt('Not logged in'); - push @body, $r->_gt($divert->{Message}); - push @body, $r->_ch('gen_login_link'); + push @body, $divert->{Message}; + push @body, $r->_ch('gen_login_link', $params); + } elsif ($kind =~ m/^MAINPAGEONLY$/) { + $title = $r->_gt('Entering secure site.'); + push @body, $divert->{Message}; + push @body, $r->_ch('gen_postmainpage_form', $params); } else { die $kind; } @@ -752,19 +818,19 @@ sub _random ($$) { my $rsp = $r->{S}{random_source}; if (!$rsf) { $v->{RandomHandle} = $rsf = new IO::File $rsp, '<' or die "$rsp $!"; -print STDERR "RH $rsf\n"; +#print STDERR "RH $rsf\n"; } my $bin; $!=0; read($rsf,$bin,$bytes) == $bytes or die "$rsp $!"; my $out = unpack "H*", $bin; - print STDERR "_random out $out\n"; +#print STDERR "_random out $out\n"; return $out; } sub _random_key ($) { my ($r) = @_; - print STDERR "_random_key\n"; +#print STDERR "_random_key\n"; my $bytes = ($r->{S}{secretbits} + 7) >> 3; return $r->_random($bytes); } @@ -786,28 +852,28 @@ sub _open_keys ($) { my ($r) = @_; my $spath = $r->_get_path('keys'); for (;;) { - print STDERR "_open_keys\n"; +#print STDERR "_open_keys\n"; my $keys = new IO::File $spath, 'r+'; if ($keys) { - print STDERR "_open_keys open\n"; +#print STDERR "_open_keys open\n"; stat $keys or die $!; # NB must not disturb stat _ my $size = (stat _)[7]; my $age = time - (stat _)[9]; - print STDERR "_open_keys open size=$size age=$age\n"; +#print STDERR "_open_keys open size=$size age=$age\n"; return $keys if $size && $age <= $r->{S}{key_rollover} / 2; - print STDERR "_open_keys open bad\n"; +#print STDERR "_open_keys open bad\n"; } # file doesn't exist, or is empty or too old if (!$keys) { - print STDERR "_open_keys closed\n"; +#print STDERR "_open_keys closed\n"; die "$spath $!" unless $!==&ENOENT; # doesn't exist, so create it just so we can lock it $keys = new IO::File $spath, 'a+'; die "$keys $!" unless $keys; stat $keys or die $!; # NB must not disturb stat _ my $size = (stat _)[7]; - print STDERR "_open_keys created size=$size\n"; +#print STDERR "_open_keys created size=$size\n"; next if $size; # oh someone else has done it, reopen and read it } # file now exists is empty or too old, we must try to replace it @@ -815,23 +881,23 @@ sub _open_keys ($) { flock $keys, LOCK_EX or die "$spath $!"; stat $spath or die "$spath $!"; my $path_inum = (stat _)[1]; - print STDERR "_open_keys locked our=$our_inum path=$path_inum\n"; +#print STDERR "_open_keys locked our=$our_inum path=$path_inum\n"; next if $our_inum != $path_inum; # someone else has done it # We now hold the lock! - print STDERR "_open_keys creating\n"; +#print STDERR "_open_keys creating\n"; my $newkeys = new IO::Handle; sysopen $newkeys, "$spath.new", O_CREAT|O_TRUNC|O_WRONLY, 0600 or die "$spath.new $!"; # we add the new key to the front which means it's always sorted print $newkeys time, ' ', $r->_random_key(), "\n" or die $!; while (my ($gen,$key,$line) = $r->_read_key($keys)) { - print STDERR "_open_keys copy1\n"; +#print STDERR "_open_keys copy1\n"; print $newkeys, $line or die $!; } $keys->error and die $!; close $newkeys or die "$spath.new $!"; rename "$spath.new", "$spath" or die "$spath: $!"; - print STDERR "_open_keys installed\n"; +#print STDERR "_open_keys installed\n"; # that rename effective unlocks, since it makes the name refer # to the new file which we haven't locked # we go round again opening the file at the beginning @@ -841,7 +907,7 @@ sub _open_keys ($) { sub _fresh_secret ($) { my ($r) = @_; - print STDERR "_fresh_secret\n"; +#print STDERR "_fresh_secret\n"; my $keys = $r->_open_keys(); my ($keyt, $key) = $r->_read_key($keys); @@ -853,7 +919,7 @@ sub _fresh_secret ($) { my $signature = $r->_hmac($key, $message); my $secret = "$keyt.$signature.$message"; - print STDERR "FRESH $secret\n"; +#print STDERR "FRESH $secret\n"; return $secret; } @@ -861,11 +927,11 @@ sub _hmac ($$$) { my ($r, $keyhex, $message) = @_; my $keybin = pack "H*", $keyhex; my $alg = $r->{S}{hash_algorithm}; -print STDERR "hmac $alg\n"; +#print STDERR "hmac $alg\n"; my $base = new Digest $alg; -print STDERR "hmac $alg $base\n"; +#print STDERR "hmac $alg $base\n"; my $digest = new Digest::HMAC $keybin, $base; -print STDERR "hmac $alg $base $digest\n"; +#print STDERR "hmac $alg $base $digest\n"; $digest->add($message); return $digest->hexdigest(); } @@ -873,7 +939,7 @@ print STDERR "hmac $alg $base $digest\n"; sub hash ($$) { my ($r, $message) = @_; my $alg = $r->{S}{hash_algorithm}; -print STDERR "hash $alg"; +#print STDERR "hash $alg\n"; my $digest = new Digest $alg; $digest->add($message); return $digest->hexdigest(); @@ -884,12 +950,30 @@ sub _assert_checked ($) { die "unchecked" unless exists $r->{Divert}; } +sub _is_post ($) { + my ($r) = @_; + my $meth = $r->_ch('get_method'); + return $meth eq 'POST'; +} + +sub _must_be_post ($) { + my ($r) = @_; + my $meth = $r->_ch('get_method'); + die "mutating non-POST" if $meth ne 'POST'; +} + sub check_mutate ($) { my ($r) = @_; $r->_assert_checked(); die if $r->{Divert}; - my $meth = $r->_ch('get_method'); - die "mutating non-POST" if $meth ne 'POST'; + $r->_must_be_post(); +} + +sub mutate_ok ($) { + my ($r) = @_; + $r->_assert_checked(); + die if $r->{Divert}; + return $r->_is_post(); } #---------- output ---------- @@ -903,7 +987,7 @@ sub secret_cookie_val ($) { sub secret_hidden_val ($) { my ($r) = @_; $r->_assert_checked(); - return defined $r->{AssocSecret} ? r->hash($r->{AssocSecret}) : ''; + return defined $r->{AssocSecret} ? $r->hash($r->{AssocSecret}) : ''; } sub secret_hidden_html ($) {