In preferences, allow the subscriptions and email fields to be cleared
[ikiwiki.git] / IkiWiki / CGI.pm
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5 use IkiWiki;
6 use IkiWiki::UserInfo;
7 use open qw{:utf8 :std};
8 use Encode;
9
10 package IkiWiki;
11
12 sub printheader ($) { #{{{
13         my $session=shift;
14         
15         if ($config{sslcookie}) {
16                 print $session->header(-charset => 'utf-8',
17                         -cookie => $session->cookie(-secure => 1));
18         } else {
19                 print $session->header(-charset => 'utf-8');
20         }
21
22 } #}}}
23
24 sub showform ($$$$) { #{{{
25         my $form=shift;
26         my $buttons=shift;
27         my $session=shift;
28         my $cgi=shift;
29
30         if (exists $hooks{formbuilder}) {
31                 run_hooks(formbuilder => sub {
32                         shift->(form => $form, cgi => $cgi, session => $session,
33                                 buttons => $buttons);
34                 });
35         }
36
37         printheader($session);
38         print misctemplate($form->title, $form->render(submit => $buttons));
39 }
40
41 sub redirect ($$) { #{{{
42         my $q=shift;
43         my $url=shift;
44         if (! $config{w3mmode}) {
45                 print $q->redirect($url);
46         }
47         else {
48                 print "Content-type: text/plain\n";
49                 print "W3m-control: GOTO $url\n\n";
50         }
51 } #}}}
52
53 sub check_canedit ($$$;$) { #{{{
54         my $page=shift;
55         my $q=shift;
56         my $session=shift;
57         my $nonfatal=shift;
58         
59         my $canedit;
60         run_hooks(canedit => sub {
61                 return if defined $canedit;
62                 my $ret=shift->($page, $q, $session);
63                 if (defined $ret) {
64                         if ($ret eq "") {
65                                 $canedit=1;
66                         }
67                         elsif (ref $ret eq 'CODE') {
68                                 $ret->() unless $nonfatal;
69                                 $canedit=0;
70                         }
71                         elsif (defined $ret) {
72                                 error($ret) unless $nonfatal;
73                                 $canedit=0;
74                         }
75                 }
76         });
77         return $canedit;
78 } #}}}
79
80 sub decode_cgi_utf8 ($) { #{{{
81         my $cgi = shift;
82         foreach my $f ($cgi->param) {
83                 $cgi->param($f, map { decode_utf8 $_ } $cgi->param($f));
84         }
85 } #}}}
86
87 sub cgi_recentchanges ($) { #{{{
88         my $q=shift;
89         
90         # Optimisation: building recentchanges means calculating lots of
91         # links. Memoizing htmllink speeds it up a lot (can't be memoized
92         # during page builds as the return values may change, but they
93         # won't here.)
94         eval q{use Memoize};
95         error($@) if $@;
96         memoize("htmllink");
97
98         eval q{use Time::Duration};
99         error($@) if $@;
100
101         my $changelog=[rcs_recentchanges(100)];
102         foreach my $change (@$changelog) {
103                 $change->{when} = concise(ago($change->{when}));
104
105                 $change->{user} = userlink($change->{user});
106
107                 my $is_excess = exists $change->{pages}[10]; # limit pages to first 10
108                 delete @{$change->{pages}}[10 .. @{$change->{pages}}] if $is_excess;
109                 $change->{pages} = [
110                         map {
111                                 $_->{link} = htmllink("", "", $_->{page},
112                                         noimageinline => 1,
113                                         linktext => pagetitle($_->{page}));
114                                 $_;
115                         } @{$change->{pages}}
116                 ];
117                 push @{$change->{pages}}, { link => '...' } if $is_excess;
118         }
119
120         my $template=template("recentchanges.tmpl"); 
121         $template->param(
122                 title => "RecentChanges",
123                 indexlink => indexlink(),
124                 wikiname => $config{wikiname},
125                 changelog => $changelog,
126                 baseurl => baseurl(),
127         );
128         run_hooks(pagetemplate => sub {
129                 shift->(page => "", destpage => "", template => $template);
130         });
131         print $q->header(-charset => 'utf-8'), $template->output;
132 } #}}}
133
134 # Check if the user is signed in. If not, redirect to the signin form and
135 # save their place to return to later.
136 sub needsignin ($$) { #{{{
137         my $q=shift;
138         my $session=shift;
139
140         if (! defined $session->param("name") ||
141             ! userinfo_get($session->param("name"), "regdate")) {
142                 $session->param(postsignin => $ENV{QUERY_STRING});
143                 cgi_signin($q, $session);
144                 cgi_savesession($session);
145                 exit;
146         }
147 } #}}}  
148
149 sub cgi_signin ($$) { #{{{
150         my $q=shift;
151         my $session=shift;
152
153         decode_cgi_utf8($q);
154         eval q{use CGI::FormBuilder};
155         error($@) if $@;
156         my $form = CGI::FormBuilder->new(
157                 title => "signin",
158                 name => "signin",
159                 charset => "utf-8",
160                 method => 'POST',
161                 required => 'NONE',
162                 javascript => 0,
163                 params => $q,
164                 action => $config{cgiurl},
165                 header => 0,
166                 template => {type => 'div'},
167                 stylesheet => baseurl()."style.css",
168         );
169         my $buttons=["Login"];
170         
171         if ($q->param("do") ne "signin" && !$form->submitted) {
172                 $form->text(gettext("You need to log in first."));
173         }
174         $form->field(name => "do", type => "hidden", value => "signin",
175                 force => 1);
176         
177         run_hooks(formbuilder_setup => sub {
178                 shift->(form => $form, cgi => $q, session => $session,
179                         buttons => $buttons);
180         });
181
182         if ($form->submitted) {
183                 $form->validate;
184         }
185
186         showform($form, $buttons, $session, $q);
187 } #}}}
188
189 sub cgi_postsignin ($$) { #{{{
190         my $q=shift;
191         my $session=shift;
192         
193         # Continue with whatever was being done before the signin process.
194         if (defined $session->param("postsignin")) {
195                 my $postsignin=CGI->new($session->param("postsignin"));
196                 $session->clear("postsignin");
197                 cgi($postsignin, $session);
198                 cgi_savesession($session);
199                 exit;
200         }
201         else {
202                 error(gettext("login failed, perhaps you need to turn on cookies?"));
203         }
204 } #}}}
205
206 sub cgi_prefs ($$) { #{{{
207         my $q=shift;
208         my $session=shift;
209
210         needsignin($q, $session);
211
212         decode_cgi_utf8($q);
213         eval q{use CGI::FormBuilder};
214         error($@) if $@;
215         my $form = CGI::FormBuilder->new(
216                 title => "preferences",
217                 name => "preferences",
218                 header => 0,
219                 charset => "utf-8",
220                 method => 'POST',
221                 validate => {
222                         email => 'EMAIL',
223                 },
224                 required => 'NONE',
225                 javascript => 0,
226                 params => $q,
227                 action => $config{cgiurl},
228                 template => {type => 'div'},
229                 stylesheet => baseurl()."style.css",
230                 fieldsets => [
231                         [login => gettext("Login")],
232                         [preferences => gettext("Preferences")],
233                         [admin => gettext("Admin")]
234                 ],
235         );
236         my $buttons=["Save Preferences", "Logout", "Cancel"];
237
238         run_hooks(formbuilder_setup => sub {
239                 shift->(form => $form, cgi => $q, session => $session,
240                         buttons => $buttons);
241         });
242         
243         $form->field(name => "do", type => "hidden");
244         $form->field(name => "email", size => 50, fieldset => "preferences");
245         $form->field(name => "subscriptions", size => 50,
246                 fieldset => "preferences",
247                 comment => "(".htmllink("", "", "ikiwiki/PageSpec", noimageinline => 1).")");
248         $form->field(name => "banned_users", size => 50,
249                 fieldset => "admin");
250         
251         my $user_name=$session->param("name");
252         if (! is_admin($user_name)) {
253                 $form->field(name => "banned_users", type => "hidden");
254         }
255
256         if (! $form->submitted) {
257                 $form->field(name => "email", force => 1,
258                         value => userinfo_get($user_name, "email"));
259                 $form->field(name => "subscriptions", force => 1,
260                         value => userinfo_get($user_name, "subscriptions"));
261                 if (is_admin($user_name)) {
262                         $form->field(name => "banned_users", force => 1,
263                                 value => join(" ", get_banned_users()));
264                 }
265         }
266         
267         if ($form->submitted eq 'Logout') {
268                 $session->delete();
269                 redirect($q, $config{url});
270                 return;
271         }
272         elsif ($form->submitted eq 'Cancel') {
273                 redirect($q, $config{url});
274                 return;
275         }
276         elsif ($form->submitted eq 'Save Preferences' && $form->validate) {
277                 foreach my $field (qw(email subscriptions)) {
278                         if (defined $form->field($field)) {
279                                 userinfo_set($user_name, $field, $form->field($field)) ||
280                                         error("failed to set $field");
281                         }
282                 }
283                 if (is_admin($user_name)) {
284                         set_banned_users(grep { ! is_admin($_) }
285                                         split(' ',
286                                                 $form->field("banned_users"))) ||
287                                 error("failed saving changes");
288                 }
289                 $form->text(gettext("Preferences saved."));
290         }
291         
292         showform($form, $buttons, $session, $q);
293 } #}}}
294
295 sub cgi_editpage ($$) { #{{{
296         my $q=shift;
297         my $session=shift;
298
299         my @fields=qw(do rcsinfo subpage from page type editcontent comments);
300         my @buttons=("Save Page", "Preview", "Cancel");
301         
302         decode_cgi_utf8($q);
303         eval q{use CGI::FormBuilder};
304         error($@) if $@;
305         my $form = CGI::FormBuilder->new(
306                 title => "editpage",
307                 fields => \@fields,
308                 charset => "utf-8",
309                 method => 'POST',
310                 required => [qw{editcontent}],
311                 javascript => 0,
312                 params => $q,
313                 action => $config{cgiurl},
314                 header => 0,
315                 table => 0,
316                 template => scalar template_params("editpage.tmpl"),
317                 wikiname => $config{wikiname},
318         );
319         
320         run_hooks(formbuilder_setup => sub {
321                 shift->(form => $form, cgi => $q, session => $session,
322                         buttons => \@buttons);
323         });
324         
325         # This untaint is safe because titlepage removes any problematic
326         # characters.
327         my ($page)=$form->field('page');
328         $page=titlepage(possibly_foolish_untaint($page));
329         if (! defined $page || ! length $page ||
330             file_pruned($page, $config{srcdir}) || $page=~/^\//) {
331                 error("bad page name");
332         }
333         
334         my $from;
335         if (defined $form->field('from')) {
336                 ($from)=$form->field('from')=~/$config{wiki_file_regexp}/;
337         }
338         
339         my $file;
340         my $type;
341         if (exists $pagesources{$page} && $form->field("do") ne "create") {
342                 $file=$pagesources{$page};
343                 $type=pagetype($file);
344                 if (! defined $type) {
345                         error(sprintf(gettext("%s is not an editable page"), $page));
346                 }
347                 if (! $form->submitted) {
348                         $form->field(name => "rcsinfo",
349                                 value => rcs_prepedit($file), force => 1);
350                 }
351                 $form->field(name => "editcontent", validate => '/.*/');
352         }
353         else {
354                 $type=$form->param('type');
355                 if (defined $type && length $type && $hooks{htmlize}{$type}) {
356                         $type=possibly_foolish_untaint($type);
357                 }
358                 elsif (defined $from && exists $pagesources{$from}) {
359                         # favor the type of linking page
360                         $type=pagetype($pagesources{$from});
361                 }
362                 $type=$config{default_pageext} unless defined $type;
363                 $file=$page.".".$type;
364                 if (! $form->submitted) {
365                         $form->field(name => "rcsinfo", value => "", force => 1);
366                 }
367                 $form->field(name => "editcontent", validate => '/.+/');
368         }
369
370         $form->field(name => "do", type => 'hidden');
371         $form->field(name => "from", type => 'hidden');
372         $form->field(name => "rcsinfo", type => 'hidden');
373         $form->field(name => "subpage", type => 'hidden');
374         $form->field(name => "page", value => pagetitle($page, 1), force => 1);
375         $form->field(name => "type", value => $type, force => 1);
376         $form->field(name => "comments", type => "text", size => 80);
377         $form->field(name => "editcontent", type => "textarea", rows => 20,
378                 cols => 80);
379         $form->tmpl_param("can_commit", $config{rcs});
380         $form->tmpl_param("indexlink", indexlink());
381         $form->tmpl_param("helponformattinglink",
382                 htmllink("", "", "ikiwiki/formatting",
383                         noimageinline => 1,
384                         linktext => "FormattingHelp"));
385         $form->tmpl_param("baseurl", baseurl());
386         
387         if ($form->submitted eq "Cancel") {
388                 if ($form->field("do") eq "create" && defined $from) {
389                         redirect($q, "$config{url}/".htmlpage($from));
390                 }
391                 elsif ($form->field("do") eq "create") {
392                         redirect($q, $config{url});
393                 }
394                 else {
395                         redirect($q, "$config{url}/".htmlpage($page));
396                 }
397                 return;
398         }
399         elsif ($form->submitted eq "Preview") {
400                 my $content=$form->field('editcontent');
401                 run_hooks(editcontent => sub {
402                         $content=shift->(
403                                 content => $content,
404                                 page => $page,
405                                 cgi => $q,
406                                 session => $session,
407                         );
408                 });
409                 $form->tmpl_param("page_preview",
410                         htmlize($page, $type,
411                         linkify($page, "",
412                         preprocess($page, $page,
413                         filter($page, $page, $content), 0, 1))));
414         }
415         elsif ($form->submitted eq "Save Page") {
416                 $form->tmpl_param("page_preview", "");
417         }
418         $form->tmpl_param("page_conflict", "");
419         
420         if ($form->submitted ne "Save Page" || ! $form->validate) {
421                 if ($form->field("do") eq "create") {
422                         my @page_locs;
423                         my $best_loc;
424                         if (! defined $from || ! length $from ||
425                             $from ne $form->field('from') ||
426                             file_pruned($from, $config{srcdir}) ||
427                             $from=~/^\// ||
428                             $form->submitted eq "Preview") {
429                                 @page_locs=$best_loc=$page;
430                         }
431                         else {
432                                 my $dir=$from."/";
433                                 $dir=~s![^/]+/+$!!;
434                                 
435                                 if ((defined $form->field('subpage') && length $form->field('subpage')) ||
436                                     $page eq gettext('discussion')) {
437                                         $best_loc="$from/$page";
438                                 }
439                                 else {
440                                         $best_loc=$dir.$page;
441                                 }
442                                 
443                                 push @page_locs, $dir.$page;
444                                 push @page_locs, "$from/$page";
445                                 while (length $dir) {
446                                         $dir=~s![^/]+/+$!!;
447                                         push @page_locs, $dir.$page;
448                                 }
449                         }
450                         push @page_locs, "$config{userdir}/$page"
451                                 if length $config{userdir};
452
453                         @page_locs = grep {
454                                 ! exists $pagecase{lc $_}
455                         } @page_locs;
456                         if (! @page_locs) {
457                                 # hmm, someone else made the page in the
458                                 # meantime?
459                                 redirect($q, "$config{url}/".htmlpage($page));
460                                 return;
461                         }
462
463                         my @editable_locs = grep {
464                                 check_canedit($_, $q, $session, 1)
465                         } @page_locs;
466                         if (! @editable_locs) {
467                                 # let it throw an error this time
468                                 map { check_canedit($_, $q, $session) } @page_locs;
469                         }
470                         
471                         my @page_types;
472                         if (exists $hooks{htmlize}) {
473                                 @page_types=keys %{$hooks{htmlize}};
474                         }
475                         
476                         $form->tmpl_param("page_select", 1);
477                         $form->field(name => "page", type => 'select',
478                                 options => [ map { pagetitle($_, 1) } @editable_locs ],
479                                 value => pagetitle($best_loc, 1));
480                         $form->field(name => "type", type => 'select',
481                                 options => \@page_types);
482                         $form->title(sprintf(gettext("creating %s"), pagetitle($page)));
483                         
484                 }
485                 elsif ($form->field("do") eq "edit") {
486                         check_canedit($page, $q, $session);
487                         if (! defined $form->field('editcontent') || 
488                             ! length $form->field('editcontent')) {
489                                 my $content="";
490                                 if (exists $pagesources{$page}) {
491                                         $content=readfile(srcfile($pagesources{$page}));
492                                         $content=~s/\n/\r\n/g;
493                                 }
494                                 $form->field(name => "editcontent", value => $content,
495                                         force => 1);
496                         }
497                         $form->tmpl_param("page_select", 0);
498                         $form->field(name => "page", type => 'hidden');
499                         $form->field(name => "type", type => 'hidden');
500                         $form->title(sprintf(gettext("editing %s"), pagetitle($page)));
501                 }
502                 
503                 showform($form, \@buttons, $session, $q);
504                 saveindex();
505         }
506         else {
507                 # save page
508                 check_canedit($page, $q, $session);
509
510                 my $exists=-e "$config{srcdir}/$file";
511
512                 if ($form->field("do") ne "create" && ! $exists &&
513                     ! eval { srcfile($file) }) {
514                         $form->tmpl_param("page_gone", 1);
515                         $form->field(name => "do", value => "create", force => 1);
516                         $form->tmpl_param("page_select", 0);
517                         $form->field(name => "page", type => 'hidden');
518                         $form->field(name => "type", type => 'hidden');
519                         $form->title(sprintf(gettext("editing %s"), $page));
520                         showform($form, \@buttons, $session, $q);
521                         return;
522                 }
523                 elsif ($form->field("do") eq "create" && $exists) {
524                         $form->tmpl_param("creation_conflict", 1);
525                         $form->field(name => "do", value => "edit", force => 1);
526                         $form->tmpl_param("page_select", 0);
527                         $form->field(name => "page", type => 'hidden');
528                         $form->field(name => "type", type => 'hidden');
529                         $form->title(sprintf(gettext("editing %s"), $page));
530                         $form->field("editcontent", 
531                                 value => readfile("$config{srcdir}/$file").
532                                          "\n\n\n".$form->field("editcontent"),
533                                 force => 1);
534                         showform($form, \@buttons, $session, $q);
535                         return;
536                 }
537                 
538                 my $content=$form->field('editcontent');
539                 run_hooks(editcontent => sub {
540                         $content=shift->(
541                                 content => $content,
542                                 page => $page,
543                                 cgi => $q,
544                                 session => $session,
545                         );
546                 });
547                 $content=~s/\r\n/\n/g;
548                 $content=~s/\r/\n/g;
549                 $content.="\n" if $content !~ /\n$/;
550
551                 $config{cgi}=0; # avoid cgi error message
552                 eval { writefile($file, $config{srcdir}, $content) };
553                 $config{cgi}=1;
554                 if ($@) {
555                         $form->field(name => "rcsinfo", value => rcs_prepedit($file),
556                                 force => 1);
557                         $form->tmpl_param("failed_save", 1);
558                         $form->tmpl_param("error_message", $@);
559                         $form->field("editcontent", value => $content, force => 1);
560                         $form->tmpl_param("page_select", 0);
561                         $form->field(name => "page", type => 'hidden');
562                         $form->field(name => "type", type => 'hidden');
563                         $form->title(sprintf(gettext("editing %s"), $page));
564                         showform($form, \@buttons, $session, $q);
565                         return;
566                 }
567                 
568                 my $conflict;
569                 if ($config{rcs}) {
570                         my $message="";
571                         if (defined $form->field('comments') &&
572                             length $form->field('comments')) {
573                                 $message=$form->field('comments');
574                         }
575                         
576                         if (! $exists) {
577                                 rcs_add($file);
578                         }
579
580                         # Prevent deadlock with post-commit hook by
581                         # signaling to it that it should not try to
582                         # do anything (except send commit mails).
583                         disable_commit_hook();
584                         $conflict=rcs_commit($file, $message,
585                                 $form->field("rcsinfo"),
586                                 $session->param("name"), $ENV{REMOTE_ADDR});
587                         enable_commit_hook();
588                         rcs_update();
589                 }
590                 
591                 # Refresh even if there was a conflict, since other changes
592                 # may have been committed while the post-commit hook was
593                 # disabled.
594                 require IkiWiki::Render;
595                 # Reload index, since the first time it's loaded is before
596                 # the wiki is locked, and things may have changed in the
597                 # meantime.
598                 loadindex();
599                 refresh();
600                 saveindex();
601
602                 if (defined $conflict) {
603                         $form->field(name => "rcsinfo", value => rcs_prepedit($file),
604                                 force => 1);
605                         $form->tmpl_param("page_conflict", 1);
606                         $form->field("editcontent", value => $conflict, force => 1);
607                         $form->field("do", "edit", force => 1);
608                         $form->tmpl_param("page_select", 0);
609                         $form->field(name => "page", type => 'hidden');
610                         $form->field(name => "type", type => 'hidden');
611                         $form->title(sprintf(gettext("editing %s"), $page));
612                         showform($form, \@buttons, $session, $q);
613                         return;
614                 }
615                 else {
616                         # The trailing question mark tries to avoid broken
617                         # caches and get the most recent version of the page.
618                         redirect($q, "$config{url}/".htmlpage($page)."?updated");
619                 }
620         }
621 } #}}}
622
623 sub cgi_getsession ($) { #{{{
624         my $q=shift;
625
626         eval q{use CGI::Session};
627         CGI::Session->name("ikiwiki_session_".encode_utf8($config{wikiname}));
628         
629         my $oldmask=umask(077);
630         my $session = CGI::Session->new("driver:DB_File", $q,
631                 { FileName => "$config{wikistatedir}/sessions.db" });
632         umask($oldmask);
633
634         return $session;
635 } #}}}
636
637 sub cgi_savesession ($) { #{{{
638         my $session=shift;
639
640         # Force session flush with safe umask.
641         my $oldmask=umask(077);
642         $session->flush;
643         umask($oldmask);
644 } #}}}
645
646 sub cgi (;$$) { #{{{
647         my $q=shift;
648         my $session=shift;
649
650         if (! $q) {
651                 eval q{use CGI};
652                 error($@) if $@;
653         
654                 $q=CGI->new;
655         
656                 run_hooks(cgi => sub { shift->($q) });
657         }
658
659         my $do=$q->param('do');
660         if (! defined $do || ! length $do) {
661                 my $error = $q->cgi_error;
662                 if ($error) {
663                         error("Request not processed: $error");
664                 }
665                 else {
666                         error("\"do\" parameter missing");
667                 }
668         }
669         
670         # Things that do not need a session.
671         if ($do eq 'recentchanges') {
672                 cgi_recentchanges($q);
673                 return;
674         }
675
676         # Need to lock the wiki before getting a session.
677         lockwiki();
678         
679         if (! $session) {
680                 $session=cgi_getsession($q);
681         }
682         
683         # Auth hooks can sign a user in.
684         if ($do ne 'signin' && ! defined $session->param("name")) {
685                 run_hooks(auth => sub {
686                         shift->($q, $session)
687                 });
688                 if (defined $session->param("name")) {
689                         # Make sure whatever user was authed is in the
690                         # userinfo db.
691                         if (! userinfo_get($session->param("name"), "regdate")) {
692                                 userinfo_setall($session->param("name"), {
693                                         email => "",
694                                         password => "",
695                                         regdate => time,
696                                 }) || error("failed adding user");
697                         }
698                 }
699         }
700         
701         if (defined $session->param("name") &&
702             userinfo_get($session->param("name"), "banned")) {
703                 print $q->header(-status => "403 Forbidden");
704                 $session->delete();
705                 print gettext("You are banned.");
706                 cgi_savesession($session);
707         }
708
709         run_hooks(sessioncgi => sub { shift->($q, $session) });
710
711         if ($do eq 'signin') {
712                 cgi_signin($q, $session);
713                 cgi_savesession($session);
714         }
715         elsif ($do eq 'prefs') {
716                 cgi_prefs($q, $session);
717         }
718         elsif ($do eq 'create' || $do eq 'edit') {
719                 cgi_editpage($q, $session);
720         }
721         elsif (defined $session->param("postsignin") || $do eq 'postsignin') {
722                 cgi_postsignin($q, $session);
723         }
724         else {
725                 error("unknown do parameter");
726         }
727 } #}}}
728
729 sub userlink ($) { #{{{
730         my $user=shift;
731
732         eval q{use CGI 'escapeHTML'};
733         error($@) if $@;
734         if ($user =~ m!^https?://! &&
735             eval q{use Net::OpenID::VerifiedIdentity; 1} && !$@) {
736                 # Munge user-urls, as used by eg, OpenID.
737                 my $oid=Net::OpenID::VerifiedIdentity->new(identity => $user);
738                 my $display=$oid->display;
739                 # Convert "user.somehost.com" to "user [somehost.com]".
740                 if ($display !~ /\[/) {
741                         $display=~s/^(.*?)\.([^.]+\.[a-z]+)$/$1 [$2]/;
742                 }
743                 # Convert "http://somehost.com/user" to "user [somehost.com]".
744                 if ($display !~ /\[/) {
745                         $display=~s/^https?:\/\/(.+)\/([^\/]+)$/$2 [$1]/;
746                 }
747                 $display=~s!^https?://!!; # make sure this is removed
748                 return "<a href=\"$user\">".escapeHTML($display)."</a>";
749         }
750         else {
751                 return htmllink("", "", escapeHTML(
752                         length $config{userdir} ? $config{userdir}."/".$user : $user
753                 ), noimageinline => 1);
754         }
755 } #}}}
756
757 1