doc/en/cgi/ports.cgi
Bill Fenner 415d223176 Make <h3> bigger and give it a horizontal rule, to provide better
visual seperation for categories.

Suggested by:	Jon Strait
2005-12-05 21:16:19 +00:00

623 lines
16 KiB
Perl
Executable file

#!/usr/bin/perl -T
#
# Copyright (c) 1996-2005 Wolfram Schneider <wosch@FreeBSD.ORG>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $FreeBSD: www/en/cgi/ports.cgi,v 1.92 2005/11/30 09:23:48 pav Exp $
#
# ports.cgi - search engine for FreeBSD ports
# o search for a port by name or description
use POSIX qw(strftime);
use Time::Local;
require "./cgi-style.pl";
$t_style = qq`<style type="text/css">
h3 { font-size: 1.2em; border-bottom: thin solid black; }
</style>
`;
sub init_variables {
$localPrefix = '/usr/ports'; # ports prefix
# Directory of the up-to-date INDEX*
$portsDatabaseHeadDir = "/usr/local/www/ports";
# Ports database file to use
if (-f "$portsDatabaseHeadDir/INDEX-6") {
$ports_database = 'INDEX-6';
} elsif (-f "$portsDatabaseHeadDir/INDEX-5") {
$ports_database = 'INDEX-5';
} else {
$ports_database = 'INDEX';
}
# URL of ports tree for browsing
$remotePrefixFtp = 'ports';
# 'ftp://ftp.FreeBSD.org/pub/FreeBSD/branches/-current/ports';
# URL of ports tree for download
$remotePrefixFtpDownload =
'http://cvsweb.FreeBSD.org/ports';
$remoteSuffixFtpDownload = '%s.tar.gz?tarball=1';
# where to get -current packages
local($p) = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/ports/i386';
local($palpha) = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/ports/alpha';
local($pamd64) = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/ports/amd64';
local($pia64) = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/ports/ia64';
local($psparc64) = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/ports/sparc64';
$remotePrefixFtpPackagesDefault = '6-STABLE/i386';
# This is currently unused
%remotePrefixFtpPackages =
(
'7-CURRENT/i386', "$p/packages-7-current/All",
'6-STABLE/i386', " $p/packages-6-stable/All",
'5-STABLE/i386', " $p/packages-5-stable/All",
'4-STABLE/i386', " $p/packages-4-stable/All",
'6.0-RELEASE/i386', "$p/packages-6.0-release/All",
'5.4-RELEASE/i386', "$p/packages-5.4-release/All",
'4.11-RELEASE/i386',"$p/packages-4.11-release/All",
'4-STABLE/alpha', "$palpha/packages-4-stable/All",
'5.4-RELEASE/alpha', "$palpha/packages-5.4-release/All",
'4.11-RELEASE/alpha',"$palpha/packages-4.11-release/All",
'7-CURRENT/amd64', "$pamd64/packages-7-current/All",
'6-STABLE/amd64', "$pamd64/packages-6-stable/All",
'5-STABLE/amd64', "$pamd64/packages-5-stable/All",
'6.0-RELEASE/amd64', "$pamd64/packages-6.0-release/All",
'5.4-RELEASE/amd64', "$pamd64/packages-5.4-release/All",
'7-CURRENT/ia64', "$pia64/packages-7-current/All",
'6-STABLE/ia64', "$pia64/packages-6-stable/All",
'6.0-RELEASE/ia64', "$pia64/packages-6.0-release/All",
'5.4-RELEASE/ia64', "$pia64/packages-5.4-release/All",
'7-CURRENT/sparc64', "$psparc64/packages-7-current/All",
'6-STABLE/sparc64', "$psparc64/packages-6-stable/All",
'5-STABLE/sparc64', "$psparc64/packages-5-stable/All",
'6.0-RELEASE/sparc64', "$psparc64/packages-6.0-release/All",
'5.4-RELEASE/sparc64', "$psparc64/packages-5.4-release/All",
);
$remotePrefixHtml =
'../ports';
# CVS Web interface
$remotePrefixCvs =
'http://cvsweb.FreeBSD.org/ports';
# Ports documentation
$portsDesc = '../ports/';
# location of the tiny BSD daemon
$daemonGif = '<IMG SRC="/gifs/littlelogo.gif" ALT="Really small BSD Daemon">';
# visible E-Mail address, plain text
$mailto = 'www@FreeBSD.org';
# Mailinglist for FreeBSD Ports
$mailtoList = 'ports@FreeBSD.org';
# use mailto:email?subject
$mailtoAdvanced = 'yes';
# the URL if you click at the E-Mail address (see below)
$mailtoURL = "mailto:$mailto" if !$mailtoURL;
# security
$ENV{'PATH'} = '/bin:/usr/bin';
# ports download sources script
$pds = 'pds.cgi';
# make plain text URLs clickable cgi script
$url = 'url.cgi';
# extension type for packages
$packageExt = 'tbz';
local($packageDB) = '../ports/packages.exists';
&packages_exist($packageDB, *packages) if -f $packageDB;
}
sub packages_exist {
local($file, *p) = @_;
open(P, $file) || do {
warn "open $file: $!\n";
warn "Cannot create packages links\n";
return 1;
};
while(<P>) {
chop;
$p{$_} = 1;
}
close P;
return 0;
}
# return the date of the last ports database update
sub last_update {
local($file) = "$portsDatabaseHeadDir/$ports_database";
local($modtime, $modtimestr);
$modtime = (stat($file))[9];
if (defined($modtime) && $modtime > 0) {
$modtimestr = strftime("%G-%m-%d %H:%M:%S UTC", gmtime($modtime));
} else {
$modtimestr = "Unknown";
}
return $modtimestr;
}
sub last_update_message {
return "<p>Last database update: " . &last_update . "<br>\n";
}
sub dec {
local($_) = @_;
s/\+/ /g; # '+' -> space
s/%(..)/pack("c",hex($1))/ge; # '%ab' -> char ab
return($_);
}
# $indent is a bit of optional data processing I put in for
# formatting the data nicely when you are emailing it.
# This is derived from code by Denis Howe <dbh@doc.ic.ac.uk>
# and Thomas A Fine <fine@cis.ohio-state.edu>
sub decode_form {
local($form, *data, $indent, $key, $_) = @_;
foreach $_ (split(/&/, $form)) {
($key, $_) = split(/=/, $_, 2);
$_ =~ s/\+/ /g; # + -> space
$key =~ s/\+/ /g; # + -> space
$_ =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes
$key =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes
$_ =~ s/[\r\n]+/\n\t/g if defined($indent); # indent data after \n
$data{$key} = $_;
}
}
# encode unknown data for use in a URL <A HREF="...">
sub encode_url {
local($_) = @_;
s/([\000-\032\;\/\?\:\@\&\=\%\'\"\`\<\>\177-\377 ])/sprintf('%%%02x',ord($1))/eg;
# s/%20/+/g;
$_;
}
sub warn { print "$_[0]" }
sub env { defined($ENV{$_[0]}) ? $ENV{$_[0]} : undef; }
sub exit { exit 0 };
sub readindex {
local(*var, *msec) = @_;
local($localportsdb) = "$portsDatabaseHeadDir/$ports_database";
local(@tmp, @s);
open(C, $localportsdb) || do {
warn "Cannot open ports database $localportsdb: $!\n"; &exit;
};
while(<C>) {
next if $query && !/$query/oi;
chop;
@tmp = split(/\|/);
$var{"$tmp[4]"} = $_;
@s = split(/\s+/, $tmp[6]);
foreach (@s) {
$msec{"$tmp[4],$_"} = 1;
}
}
close C;
}
# extract sub collections
sub readcoll {
local(@a, @b, %key);
local($file) = '../ports/categories';
local($localportsdb) = "$portsDatabaseHeadDir/$ports_database";
if (-r $file && open(C, $file)) {
while(<C>) {
chop;
if (/^\s*([^,]+),\s*"([^"]+)",\s*([A-Z]+)/) {
@b = split(/\s+/, $1);
foreach (@b) {
if (!defined($key{$_})) {
$key{$_} = 1;
}
}
}
}
} else {
if (-r $localportsdb) {
open(C, $localportsdb) || do {
warn "Cannot open ports database $localportsdb: $!\n"; &exit;
}
}
while(<C>) {
chop;
@a = split('\|');
@b = split(/\s+/, $a[6]);
foreach (@b) {
if (!defined($key{$_})) {
$key{$_} = 1;
}
}
}
}
close C;
@a = ();
foreach (sort keys %key) {
push(@a, $_);
}
return @a;
}
# basic function for HTML output
sub out {
local($line) = @_;
local($version, $path, $local, $comment, $descfile, $email,
$sections, $bdepends, $rdepends, @rest) = split(/\|/, $line);
if ($path =~ m%^$localPrefix/([^/]+)%o) {
if (!$out_sec || $1 ne $out_sec) {
print "</DL>\n" if $counter > 0;
print qq{\n<H3>} .
qq{<a href="$remotePrefixHtml/$1.html">Category $1</a>} .
"</H3>\n<DL>\n";
$out_sec = $1;
}
}
$counter++;
$pathDownload = $path;
$pathB= $path;
$pathB =~ s/^$localPrefix/ports/o;
$path =~ s/^$localPrefix/$remotePrefixFtp/o;
$pathDownload =~ s/^$localPrefix/$remotePrefixFtpDownload/o;
if ($remoteSuffixFtpDownload) {
if (substr($remoteSuffixFtpDownload, 0, 2) eq '%s') {
$pathDownload =~ m,([^/]+)$,;
$pathDownload .= "/$1" . substr($remoteSuffixFtpDownload, 2);
} else {
$pathDownload .= $remoteSuffixFtpDownload;
}
}
$descfile =~ s/^$localPrefix/$remotePrefixFtp/o;
$comment =~ s/</\&lt;/g;
$comment =~ s/>/\&gt;/g;
local($l) = $path;
$l =~ s%^$remotePrefixFtp%$remotePrefixCvs%o;
print qq{<DT><B><A NAME="$version"></A><A HREF="$l">$version</A></B>\n};
print qq{<DD>$comment<BR>\n};
print qq[<A HREF="$url?$descfile">Long description</A> <B>:</B>\n];
print qq[<A HREF="$pds?$pathB">Sources</A> <B>:</B>\n];
# Link package in "default" arch/release. Verify it's existence on ftp-master.
if ($packages{"$version.$packageExt"}) {
print qq[<A HREF="$remotePrefixFtpPackages{$remotePrefixFtpPackagesDefault}/$version.$packageExt">Package</A> <B>:</B>\n];
}
print qq[<A HREF="$l">Changes</A> <B>:</B> <A HREF="$pathDownload">Download</A><BR>\n];
print qq{<I>Maintained by:</I> <A HREF="mailto:$email} .
($mailtoAdvanced ?
qq{?cc=$mailtoList&amp;subject=FreeBSD%20Port:%20} .
&encode_url($version) : '') . qq{">$email</A><BR>};
local(@s) = split(/\s+/, $sections);
if ($#s > 0) {
print qq{<I>Also listed in:</I> };
foreach (@s) {
print qq{<A HREF="$remotePrefixHtml/$_.html">$_</A> }
if $_ ne $out_sec;
}
print "<BR>\n";
}
if ($bdepends || $rdepends) {
local($flag) = 0;
local($last) = '';
print qq{<I>Requires:</I> };
foreach (sort split(/\s+/, "$bdepends $rdepends")) {
# delete double entries
next if $_ eq $last;
$last = $_;
print ", " if $flag;
$flag++;
print qq{<A HREF="$script_name?query=^$_&amp;stype=name">$_</A>};
}
print "<BR>\n";
}
print q[<p>];
};
# search and output
sub search_ports {
local(@a) = ();
local($key, $name, $text);
foreach $key (sort keys %today) {
next if $today{$key} !~ /$query/oi;
@a = split(/\|/, $today{$key});
$name = $a[0]; #$name =~ s/(\W)/\\$1/g;
$text = $a[3]; #$text =~ s/(\W)/\\$1/g;
if ($section ne "all") {
next if $a[6] !~ /^$section(\s|$)/;
}
#warn "$stype:$query: $name $text\n";
if ($stype eq "name" && $name =~ /$query/o) {
&out($today{$key});
} elsif ($stype eq "text" && $text =~ /$query/oi) {
&out($today{$key});
} elsif ($stype eq "all" &&
($text =~ /$query/oi || $name =~ /$query/io)) {
&out($today{$key});
} elsif ($stype eq 'maintainer' && $a[5] =~ /$query/io) {
&out($today{$key});
} elsif ($stype eq 'requires' &&
($a[7] =~ /$query/io || $a[8] =~ /$query/io)) {
&out($today{$key});
}
}
}
sub forms {
print qq{<P>
FreeBSD Ports [short description <a href="$portsDesc">followed</a> ...]
<a href="$script_name?stype=faq">FAQ</a>
<p>
};
print qq{
"Package Name" searches for the name of a port or distribution.
"Description" searches case-insensitive in a short comment about the port.
"All" searches case-insensitive for the package name and in the
description about the port.
<p>
<FORM METHOD="GET" ACTION="$script_name">
Search for:
<INPUT NAME="query" VALUE="$query">
<SELECT NAME="stype">
};
local(%d);
%d = ('name', 'Package Name',
'all', 'All',
'maintainer', 'Maintainer',
'text', 'Description',
'pkgdescr', 'Long Description',
'requires', 'Requires',
);
foreach ('all', 'name', 'text', 'pkgdescr', 'maintainer', 'requires') {
print "<OPTION" . (($_ eq $stype) ? ' SELECTED ' : ' ') .
qq{VALUE="$_">} . ($d{$_} ? $d{$_} : $_) . qq{</OPTION>\n};
}
print qq{</SELECT>
<SELECT NAME="sektion">
<OPTION VALUE="all">All Sections</OPTION>
};
foreach (@sec) {
print "<OPTION" .
(($_ eq $section) ? ' SELECTED ' : ' ') .
qq{VALUE="$_">$_</OPTION>\n};
}
print q{</SELECT>
<INPUT TYPE="submit" VALUE="Submit">
</FORM>
<HR noshade>
};
}
sub footer {
print qq{
<img ALIGN="RIGHT" src="/gifs/powerlogo.gif" alt="Powered by FreeBSD">
&copy; 1996-2005 by Wolfram Schneider. All rights reserved.<br>
};
#print q{$FreeBSD: www/en/cgi/ports.cgi,v 1.92 2005/11/30 09:23:48 pav Exp $} . "<br>\n";
print qq{Please direct questions about this service to
<I><A HREF="$mailtoURL">$mailto</A></I><br>\n};
print qq{General questions about FreeBSD ports should be sent to } .
qq{<a href="mailto:$mailtoList">} .
qq{<i>$mailtoList</i></a><br>\n};
print &last_update_message;
print "<hr noshade>\n<P>\n";
}
sub check_input {
if ($query) {
$stype = "all" if !$stype;
if (!($stype eq "name" ||
$stype eq "text" ||
$stype eq "maintainer" ||
$stype eq "requires" ||
$stype eq "all")) {
&warn("unknown search type ``$type'', use `all', `text', `name', 'requires', or `maintainer'\n");
&exit(0);
} else {
return;
}
}
}
sub faq {
print qq{<H1>FreeBSD Ports Search FAQ</h1>
<h2>Keywords</h2>
<dl>
<dt><b>Description</b><dd>A more detailed description.
<dt><b>Download</b><dd>Download the ports directory.
<dt><b>Package</b><dd>Download the pre-compiled software package.
<dt><b>Changes</b><dd>Read the latest changes.
<dt><b>Sources</b><dd>Links to all source files.
</dl>
<h2>Misc</h2>
Package download links point to the FreeBSD 6-STABLE
version and <b>not</b> to the latest releases.<p>
The script ports.cgi use the file
<a href="../ports/$ports_database.bz2">$ports_database</a>
as database for it's operations. $ports_database is updated automatically every
two hours.<p>
You may also search the
<a href="http://www.FreeBSD.org/cgi/man.cgi?manpath=FreeBSD+Ports">ports manual pages</a>.<p>
Get the <a href ="source">Source</a> of this script.<p>
<a href="$script_name">Back to the search engine</a><p>
<HR noshade>
};
}
#
# Main
#
&init_variables;
$query_string = &env('QUERY_STRING');
$path_info = &env('PATH_INFO');
&decode_form($query_string, *form);
$section = $form{'sektion'};
$section = 'all' if (!$section);
$query = $form{'query'};
$stype = $form{'stype'};
$script_name = &env('SCRIPT_NAME');
if ($path_info eq "/source") {
# XXX
print "Content-type: text/plain\n\n";
open(R, $0) || do { print "ick!\n"; &exit; };
while(<R>) { print }
close R;
&exit;
}
# Full text search in ports/<category>/port>/pkg-descr
if ($stype eq 'pkgdescr') {
local($url) =
'http://www.FreeBSD.org/cgi/search.cgi?source=pkgdescr&max=25';
$query =~ s/\s+/+/g;
print "Location: $url&words=$query\n\n";
&exit;
}
if ($stype eq "faq") {
print &short_html_header("FreeBSD Ports Search FAQ", 0);
&faq;
&footer; print &html_footer; &exit(0);
}
print &html_header("FreeBSD Ports Search", 0);
# allow `/ports.cgi?netscape' where 'netscape' is the query port to search
# this make links to this script shorter
if (!$query && $query_string =~ /^([^=&]+)$/) {
$query = $1;
}
# automatically read collections, need only 0.2 sec on a pentium
@sec = &readcoll;
&forms;
$query =~ s/^\s+//;
$query =~ s/\s+$//;
if ($query_string eq "" || !$query) {
&footer; print &html_footer; &exit(0);
}
&check_input;
$counter = 0;
# search
if ($query) {
&readindex(*today, *msec);
$query =~ s/([^\w\^])/\\$1/g;
&search_ports;
}
if (!$counter) {
print "Sorry, nothing found.\n";
print qq{You may look for other } .
qq{<a href="/search/search.html">FreeBSD Search Services</a>.\n};
} else {
print "</dl>\n";
}
print "<hr noshade>\n";
&footer;
print &html_footer;