webmin-search-lib.pl

   1 # Functions for searching the webmin docs and UI
   2
   3 =head2 search_webmin(phrase, [callback-function], [&modules])
   4
   5 Searches all Webmin help pages, UI text, module names and config.info files
   6 for entries matching the given phrase or word. Returns them sorted by relevance
   7 order, each as a hash ref with the following keys :
   8
   9 =item mod - A module hash reference for the module the search result was in
  10
  11 =item rank - A result ranking, higher being better
  12
  13 =item type - One of mod (for module name), dir (for module directory), config (configuration setting), help (help page) or text (UI text)
  14
  15 =item text - The text that matched
  16
  17 =items cgis - An array ref of pages on which the text appears, each formatted like module/script.cgi
  18
  19 =cut
  20 sub search_webmin
  21 {
  22 my ($re, $cbfunc, $onlymods) = @_;
  23
  24 # Work out this Webmin's URL base
  25 my $urlhost = $ENV{'HTTP_HOST'};
  26 if ($urlhost !~ /:/) {
  27         $urlhost .= ":".$ENV{'SERVER_PORT'};
  28         }
  29 my $urlbase = ($ENV{'HTTPS'} eq 'ON' ? 'https://' : 'http://').$urlhost;
  30
  31 # Search module names and add to results list
  32 my @rv = ( );
  33 my $pn = &get_product_name();
  34 my @mods;
  35 if ($onlymods) {
  36         # Modules specified by caller
  37         @mods = grep { &foreign_available($_->{'dir'}) } @$onlymods;
  38         }
  39 else {
  40         # All reasonable modules
  41         @mods = &get_available_module_infos();
  42         }
  43 @mods = grep { !$_->{'clone'} }
  44           grep { !$_->{'noui'} && !$_->{$pn.'_noui'} } @mods;
  45 @mods = sort { $b->{'longdesc'} cmp $a->{'longdesc'} } @mods;
  46 foreach my $m (@mods) {
  47         if ($m->{'desc'} =~ /\Q$re\E/i) {
  48                 # Module description match
  49                 push(@rv, { 'mod' => $m,
  50                             'rank' => 10,
  51                             'type' => 'mod',
  52                             'link' => $m->{'dir'}.'/',
  53                             'text' => $m->{'desc'} });
  54                 }
  55         elsif ($m->{'longdesc'} =~ /\Q$re\E/i) {
  56                 # Module long description match
  57                 push(@rv, { 'mod' => $m,
  58                             'rank' => 9.5,
  59                             'type' => 'mod',
  60                             'link' => $m->{'dir'}.'/',
  61                             'text' => $m->{'longdesc'} });
  62                 }
  63         elsif ($m->{'dir'} =~ /\Q$re\E/i) {
  64                 # Module directory match
  65                 push(@rv, { 'mod' => $m,
  66                             'rank' => 9,
  67                             'type' => 'dir',
  68                             'link' => $m->{'dir'}.'/',
  69                             'text' => $urlbase."/".$m->{'dir'}."/" });
  70                 }
  71         &$cbfunc() if ($cbfunc);
  72         }
  73
  74 # Search module configs and their help pages
  75 foreach my $m (@mods) {
  76         my %access = &get_module_acl(undef, $m);
  77         next if ($access{'noconfig'});
  78         my $file = $prod eq 'webmin' ? "$m->{'dir'}/config.info"
  79                                      : "$m->{'dir'}/uconfig.info";
  80         my %info = ( );
  81         my @info_order = ( );
  82         &read_file($file, \%info, \@info_order);
  83         foreach my $o (@lang_order_list) {
  84                 &read_file("$file.$o", \%info);
  85                 }
  86         my $section = undef;
  87         foreach my $c (@info_order) {
  88                 my @p = split(/,/, $info{$c});
  89                 if ($p[1] == 11) {
  90                         $section = $c;
  91                         }
  92                 if ($p[0] =~ /\Q$re\E/i) {
  93                         # Config description matches
  94                         push(@rv, { 'mod' => $m,
  95                                     'rank' => 8,
  96                                     'type' => 'config',
  97                                     'link' => "/config.cgi?module=$m->{'dir'}&".
  98                                              "section=".&urlize($section)."#$c",
  99                                     'text' => $p[0],
 100                                   });
 101                         }
 102                 my $hfl = &help_file($mod->{'dir'}, "config_".$c);
 103                 my ($title, $help) = &help_file_match($hfl);
 104                 if ($help) {
 105                         # Config help matches
 106                         push(@rv, { 'mod' => $m,
 107                                     'rank' => 6,
 108                                     'type' => 'help',
 109                                     'link' => "/help.cgi/$m->{'dir'}/config_".$c,
 110                                     'desc' => &text('wsearch_helpfor', $p[0]),
 111                                     'text' => $help,
 112                                     'cgis' => [ "/config.cgi?".
 113                                                 "module=$m->{'dir'}&section=".
 114                                                 &urlize($section)."#$c" ],
 115                                    });
 116                         }
 117                 }
 118         &$cbfunc() if ($cbfunc);
 119         }
 120
 121 # Search other help pages
 122 my %lang_order_list = map { $_, 1 } @lang_order_list;
 123 foreach my $m (@mods) {
 124         my $helpdir = &module_root_directory($m->{'dir'})."/help";
 125         my %donepage = ( );
 126         opendir(DIR, $helpdir);
 127         foreach my $f (sort { length($b) <=> length($a) } readdir(DIR)) {
 128                 next if ($f =~ /^config_/);     # For config help, already done
 129
 130                 # Work out if we should grep this help page - don't do the same
 131                 # page twice for different languages
 132                 my $grep = 0;
 133                 my ($page, $lang);
 134                 if ($f =~ /^(\S+)\.([^\.]+)\.html$/) {
 135                         ($page, $lang) = ($1, $2);
 136                         if ($lang_order_list{$lang} && !$donepage{$page}++) {
 137                                 $grep = 1;
 138                                 }
 139                         }
 140                 elsif ($f =~ /^(\S+)\.html$/) {
 141                         $page = $1;
 142                         if (!$donepage{$page}++) {
 143                                 $grep = 1;
 144                                 }
 145                         }
 146
 147                 # If yes, search it
 148                 if ($grep) {
 149                         my ($title, $help) = &help_file_match("$helpdir/$f");
 150                         if ($title) {
 151                                 my @cgis = &find_cgi_text(
 152                                         [ "hlink\\(.*'$page'",
 153                                           "hlink\\(.*\"$page\"",
 154                                           "header\\([^,]+,[^,]+,[^,]+,\\s*\"$page\"",
 155                                           "header\\([^,]+,[^,]+,[^,]+,\\s*'$page'",
 156                                         ], $m, 1);
 157                                 push(@rv, { 'mod' => $m,
 158                                             'rank' => 6,
 159                                             'type' => 'help',
 160                                             'link' => "/help.cgi/$m->{'dir'}/$page",
 161                                             'desc' => $title,
 162                                             'text' => $help,
 163                                             'cgis' => \@cgis });
 164                                 }
 165                         }
 166                 &$cbfunc() if ($cbfunc);
 167                 }
 168         closedir(DIR);
 169         }
 170
 171 # Then do text strings
 172 my %gtext = &load_language("");
 173 MODULE: foreach my $m (@mods) {
 174         my %mtext = &load_language($m->{'dir'});
 175         foreach my $k (keys %mtext) {
 176                 next if ($gtext{$k});   # Skip repeated global strings
 177                 $mtext{$k} =~ s/\$[0-9]//g;
 178                 if ($mtext{$k} =~ /\Q$re\E/i) {
 179                         # Find CGIs that use this text
 180                         my @cgis = &find_cgi_text(
 181                                 [ "\$text{'$k'}",
 182                                   "\$text{\"$k\"}",
 183                                   "\$text{$k}",
 184                                   "&text('$k'",
 185                                   "&text(\"$k\"" ], $m);
 186                         if (@cgis) {
 187                                 push(@rv, { 'mod' => $m,
 188                                             'rank' => 4,
 189                                             'type' => 'text',
 190                                             'text' => $mtext{$k},
 191                                             'cgis' => \@cgis });
 192                                 }
 193                         }
 194                 }
 195         &$cbfunc() if ($cbfunc);
 196         }
 197
 198 # Sort results by relevancy
 199 # XXX can do better?
 200 @rv = sort { $b->{'rank'} <=> $a->{'rank'} ||
 201              lc($a->{'mod'}->{'desc'}) cmp lc($b->{'mod'}->{'desc'}) } @rv;
 202 return @rv;
 203 }
 204
 205 # highlight_text(text, [length])
 206 # Returns text with the search term bolded, and truncated to 50 characters
 207 sub highlight_text
 208 {
 209 local ($str, $len) = @_;
 210 $len ||= 50;
 211 local $hlen = $len / 2;
 212 $str =~ s/<[^>]*>//g;
 213 if ($str =~ /(.*)(\Q$re\E)(.*)/i) {
 214         local ($before, $match, $after) = ($1, $2, $3);
 215         if (length($before) > $hlen) {
 216                 $before = "...".substr($before, length($before)-$hlen);
 217                 }
 218         if (length($after) > $hlen) {
 219                 $after = substr($after, 0, $hlen)."...";
 220                 }
 221         $str = $before."<b>".&html_escape($match)."</b>".$after;
 222         }
 223 return $str;
 224 }
 225
 226 # find_cgi_text(&regexps, module, re-mode)
 227 # Returns the relative URLs of CGIs that matches some regexps, in the given
 228 # module. Does not include those that don't call some header function, as
 229 # they cannot be linked to normally
 230 sub find_cgi_text
 231 {
 232 local ($res, $m, $remode) = @_;
 233 local $mdir = &module_root_directory($m);
 234 local @rv;
 235 foreach my $f (glob("$mdir/*.cgi")) {
 236         local $found = 0;
 237         local $header = 0;
 238         open(CGI, $f);
 239         LINE: while(my $line = <CGI>) {
 240                 if ($line =~ /(header|ui_print_header|ui_print_unbuffered_header)\(/) {
 241                         $header++;
 242                         }
 243                 foreach my $r (@$res) {
 244                         if (!$remode && index($line, $r) >= 0 ||
 245                             $remode && $line =~ /$r/) {
 246                                 $found++;
 247                                 last LINE;
 248                                 }
 249                         }
 250                 }
 251         close(CGI);
 252         if ($found && $header) {
 253                 local $url = $f;
 254                 $url =~ s/^\Q$root_directory\E\///;
 255                 push(@rv, $url);
 256                 }
 257         }
 258 return @rv;
 259 }
 260
 261 # help_file_match(file)
 262 # Returns the title if some help file matches the current search
 263 sub help_file_match
 264 {
 265 local ($f) = @_;
 266 local $data = &read_file_contents($f);
 267 local $title;
 268 if ($data =~ /<header>([^<]*)<\/header>/) {
 269         $title = $1;
 270         }
 271 $data =~ s/\s+/ /g;
 272 $data =~ s/<p>/\n\n/gi;
 273 $data =~ s/<br>/\n/gi;
 274 $data =~ s/<[^>]+>//g;
 275 if ($data =~ /\Q$re\E/i) {
 276         return ($title, $data);
 277         }
 278 return ( );
 279 }
 280
 281 # cgi_page_title(module, cgi)
 282 # Given a CGI, return the text for its page title, if possible
 283 sub cgi_page_title
 284 {
 285 local ($m, $cgi) = @_;
 286 local $data = &read_file_contents(&module_root_directory($m)."/".$cgi);
 287 local $rv;
 288 if ($data =~ /(ui_print_header|ui_print_unbuffered_header)\([^,]+,[^,]*(\$text{'([^']+)'|\$text{"([^"]+)"|\&text\('([^']+)'|\&text\("([^"]+)")/) {
 289         # New header function, with arg before title
 290         local $msg = $3 || $4 || $5 || $6;
 291         local %mtext = &load_language($m);
 292         $rv = $mtext{$msg};
 293         }
 294 elsif ($data =~ /(^|\s|mail_page_)header\(\s*(\$text{'([^']+)'|\$text{"([^"]+)"|\&text\('([^']+)'|\&text\("([^"]+)")/) {
 295         # Old header function
 296         local $msg = $3 || $4 || $5 || $6;
 297         local %mtext = &load_language($m);
 298         $rv = $mtext{$msg};
 299         }
 300 if ($cgi eq "index.cgi" && !$rv) {
 301         # If no title was found for an index.cgi, use module title
 302         local %minfo = &get_module_info($m);
 303         $rv = $minfo{'desc'};
 304         }
 305 return $rv;
 306 }
 307
 308 # cgi_page_args(module, cgi)
 309 # Given a module and CGI name, returns a string of URL parameters that can be
 310 # used for linking to it. Returns "none" if parameters are needed, but cannot
 311 # be determined.
 312 sub cgi_page_args
 313 {
 314 local ($m, $cgi) = @_;
 315 local $mroot = &module_root_directory($m);
 316 if (-r "$mroot/cgi_args.pl") {
 317         # Module can tell us what args to use
 318         &foreign_require($m, "cgi_args.pl");
 319         $args = &foreign_call($m, "cgi_args", $cgi);
 320         if (defined($args)) {
 321                 return $args;
 322                 }
 323         }
 324 if ($cgi eq "index.cgi") {
 325         # Index page is always safe to link to
 326         return undef;
 327         }
 328 # Otherwise check if it appears to parse any args
 329 local $data = &read_file_contents($mroot."/".$cgi);
 330 if ($data =~ /(ReadParse|ReadParseMime)\(/) {
 331         return "none";
 332         }
 333 return undef;
 334 }
 335
 336 1;
 337