webmin-search-lib.pl

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