head	1.4;
access;
symbols;
locks
	ids:1.4; strict;
comment	@# @;


1.4
date	2005.07.06.20.01.10;	author ids;	state Exp;
branches;
next	1.3;

1.3
date	2000.11.28.22.21.03;	author ids;	state Exp;
branches;
next	1.2;

1.2
date	2000.11.27.21.25.29;	author ids;	state Exp;
branches;
next	1.1;

1.1
date	2000.11.27.20.59.05;	author ids;	state Exp;
branches;
next	;


desc
@@


1.4
log
@new version of Crit active as a CGI-script.
@
text
@#!/bin/sh -
#
#	This wrapper around the Crit mediator script is just to allow
#	a shorter "Crit URL prefix" than the default you get with the
#	standard directory structure.
#
#	(We unfortunately can't shorten it further from "nph-crit.cgi" to just
#	"crit.cgi" - the "nph-" prefix seems to have some special significance
#	for our web server, telling it to expect the fuller HTTP header style
#	the mediator script provides.)
#
exec /homes/ids/misc/research_related/AnnotatingTheWeb/CritSuite/crit-0.9.2-ids-0.0.2-as-cgi-script/web/nph-med.cgi "$@@"
@


1.3
log
@cut down to just a wrapper around the "real" Crit mediator script.
(Much easier to maintain, and honest about what it is!)
@
text
@d12 1
a12 1
exec /homes/ids/misc/research_related/AnnotatingTheWeb/CritSuite/crit-0.9.2-ids-0.0.1-as-cgi-script/web/nph-med.cgi "$@@"
@


1.2
log
@tweaked Perl include arrangements to work from this location:

> #     tweak to look explicitly in the standard directory structure,
> #     since this copy is in a location that gives a shorter "Crit URL prefix"
> #     than the default you get with the standard directory structure,
> #     and is thus "orphaned" from there.
> #
> #     (We unfortunately can't shorten it further from "nph-crit.cgi" to just
> #     "crit.cgi" - the "nph-" prefix seems to have some special significance
> #     for our web server, telling it to expect the fuller HTTP header style
> #     this mediator script provides.)
@
text
@d1 1
a1 36
#!/usr/bin/perl
# CritLink Mediator: CGI request handler.

# The CritLink Mediator and CritWriter software is copyright
# 1997 by Ka-Ping Yee (http://www.lfw.org/ping/).  All rights
# reserved.  Written for a project of the Foresight Institute.
# 
# This software is provided by Ka-Ping Yee under the following
# license.  By using, copying, or modifying this software, you
# agree that you understand and will comply with the following
# terms and conditions: permission to use, copy, modify, and
# distribute this software and documentation for any purpose
# is granted, PROVIDED (a) that the full text of this notice
# appears on all copies of the software and documentation or
# portions or derivations thereof, and (b) that the preceding
# paragraph, containing the copyright, is displayed (together
# with other copyright notices if any) by all products that
# incorporate this software or portions or derivations thereof.
# If possible, we prefer that the URL be an active hyperlink.
# 
# THIS SOFTWARE IS PROVIDED "AS IS".  KA-PING YEE AND FORESIGHT
# INSTITUTE MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
# IMPLIED, INCLUDING, BUT NOT LIMITED TO, REPRESENTATIONS OR
# WARRANTIES OF MERCHANTABILITY OR FITNESS FOR ANY PARTICULAR
# PURPOSE OR THAT THE USE OF THE SOFTWARE WILL NOT INFRINGE ANY
# THIRD-PARTY PATENTS, COPYRIGHTS, TRADEMARKS, OR OTHER RIGHTS.
# NEITHER KA-PING YEE NOR FORESIGHT INSTITUTE WILL BEAR ANY
# LIABILITY FOR ANY USE OF THIS SOFTWARE OR DOCUMENTATION.
# 
# The name and trademarks of Ka-Ping Yee and the Foresight
# Institute may not be used in publicity about this software
# without prior written permission (please contact us at
# <ping@@foresight.org>).  Title to copyright in this software
# and documentation will at all times remain with the author.

# Look for "M1config.pm" in the lib/ sibling directory.
d3 3
a5 4
#	tweak to look explicitly in the standard directory structure,
#	since this copy is in a location that gives a shorter "Crit URL prefix"
#	than the default you get with the standard directory structure,
#	and is thus "orphaned" from there.
d10 1
a10 1
#	this mediator script provides.)
d12 1
a12 108
# BEGIN { push(@@INC, (($0 =~ /(.*)\/./) ? $1 : '.') . '/../lib'); }
BEGIN { push(@@INC, '/homes/ids/misc/research_related/AnnotatingTheWeb/CritSuite/crit-0.9.2-ids-0.0.1-as-cgi-script/lib'); }

use M1config;

use cgi;
use sprocket;
use tee;
use M1output;
use M1finder;
use M1gather;
use M1http;
use M1lex;
use M1db;
use M1med;
use M1start;
use M1token;
use M1ui;
use M1url;

$ENV{'PATH'} = '';
$ENV{'SHELL'} = '/bin/sh';
$SIG{'ALRM'} = 'diealarm';
alarm $M1config::servertimeout;
sub diealarm
    {
    if (ref($ui) eq 'M1ui')
        { $ui->recv(new M1token('error:timeout')); }
    else
        { print NS ">>>\n\nTIMEOUT!\n"; }
    exit;
    }

$uri = $cgi::pathinfo;

if ($cgi::method eq 'GET')
    {
    &cgi::readform;

    # trapdoor for URL specified in a form field
    if ($target = $cgi::form{'_M1_URL'})
        {
        &cgi::httpheaders('302 Found',
                          'Location: ' . &M1med::mediate($target));
        exit;
        }
    }

# extract the real target URL
$url = new M1url(&M1med::unmediate($uri));
$url->{'query'} = $cgi::query;
$requrl = $url->canon();
$tfrag = $url->{'frag'};

# need to create a UI before we can send any errors to it
$output = new M1output();
$db = new M1db($M1config::dbpath);
$ui = new M1ui(new M1med($output), $db, $tfrag);

if ($uri !~ m#[^\s/]#)
    { $ui->recv(new M1token('error:nourl')); exit; }
if ($url->{'scheme'} ne 'http')
    { $ui->recv(new M1token('error:badscheme')); exit; }

# record the request
open(LOG, '>>' . $M1config::logfile);
($s, $m, $h, $d, $l, $y) = localtime(time());
$td = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $y+1900, $l+1, $d, $h, $m, $s);
printf LOG "$td $cgi::method $requrl $cgi::ident @@ $cgi::remotehost\n";
close(LOG);

# filter the HTTP headers appropriately
for $var (keys %ENV)
    {
    next unless $var =~ /^HTTP_/;
    my ($name, $value) = ($var, $ENV{$var});
    $name =~ tr/A-Z_/a-z-/;
    $value = $url->serverport() if $name eq 'host';
    $value =~ &M1med::unmediate($value) if $name eq 'referer';
    $value = 'close' if $name eq 'connection' and $value =~ /keep-alive/i;
    next if $name eq 'if-modified-since';
    push(@@headers, "$name: $value");
    }

# method-specific errands
if ($cgi::method eq 'POST' and $cgi::contentlength)
    {
    read(STDIN, $entity, $cgi::contentlength);
    push(@@headers, "Content-Type: $cgi::contenttype");
    push(@@headers, "Content-Length: $cgi::contentlength");
    }
elsif ($cgi::method eq 'GET')
    { }
else
    { $ui->recv(new M1token('error:badmethod')); exit; }

$| = 1;

new M1http(
    new M1lex(
        new M1start(
            new tee(
                new M1finder($ui, $db, $tfrag),
                new M1gather($db)
                )
            )
        )
    )->fetch($cgi::method, $url, $entity, @@headers);
@


1.1
log
@Initial revision
@
text
@d37 13
a49 1
BEGIN { push(@@INC, (($0 =~ /(.*)\/./) ? $1 : '.') . '/../lib'); }
@