#!/usr/local/bin/perl
#
# read-comics
#
# Version 1.04, (4 April 1995)
# 
# Author: Jennifer Myers <jmyers@eecs.nwu.edu>
#
# 'read-comics' is a Common Gateway Interface (CGI) script for CGI-compliant 
# HTTP servers (e.g., NCSA httpd).  'read-comics' generates a hypertext 
# interface to the ClariNet electronic newspaper's cartoon newsgroups.  
# It does this by querying the NNTP server for a list of active articles 
# in the newsgroup and then generates from this, a list of hyperlinks.  
# When a link is selected, the article is retrieved from the NNTP server and 
# then (base64) decoded on-the-fly.
#
# The links: 
#      http://www-server.domain/cgi-bin/read-comics/dilbert?today 
#      http://www-server.domain/cgi-bin/read-comics/bizarro?today 
#      http://www-server.domain/cgi-bin/read-comics/worldviews?today 
# will point to the most recent of that cartoon.
#
# This script will not work with NCSA Mosaic for Windows versions prior
# to version 2.0 A8.
#
# Connecting hosts not in $domain are denied access.
#
# Retrieval instructions:
#
#    The latest version of 'read-comics' may be retrieved from the WWW as
#	http://www.eecs.nwu.edu/~jmyers/cgi-src/read-comics
#    or by anonymous ftp as
#	eecs.nwu.edu:/pub/jmyers/cgi-src/read-comics
#
# Installation:
#
#    Configure $domain, $nntphost, and ${dilbert,bizarro,worldviews}_group 
#    as appropriate.
#
#    Put this script in your CGI bin directory.  For example, on my 
#       server, I have this script installed as: 
#       http://www.eecs.nwu.edu/cgi-bin/read-comics
#
#    If you can run the script, but are denied access, set $ip_mask
#	appropriately.
#
# Acknowledgements:
#
#   The NNTP code is adopted from code for a NNTP client written by 
# 	Eric Young <eay@psych.psy.uq.oz.au>
#   The base64decode algorithm comes from the base64 package by
#       Shingo Fujimoto <shingo@wide.ad.jp>
#   Thanks to all the people who offered code or otherwise suggested 
#       that read-comics be expanded to include the new strips Bizarro 
#       and Views of the World.
#
# Revision History:
#
# 4/4/95:       Version 1.04: Dilbert is no longer available from 
#               Clarinet.  New pointer added.
#
# 11/29/94:     Version 1.03: Skip over the Dilbert Newsletter
#               when retrieving dilbert?today (thanks Ed Kubaitis
#               <ejk@ux2.cso.uiuc.edu>).
#
# 11/28/94:     Version 1.02: The link to today's comic in &getlinks was
#               still of the old syntax.  Fixed.  Thank you to James 
#               Mathiesen <JAMES@BROWNVM.brown.edu> and Don Geddis 
#               <geddis@CS.Stanford.EDU> for reporting this problem.
#               James Mathiesen also brought it to my attention that this
#               script will not work with NCSA Mosaic for Windows 2.0a7 
#               due to a problem with that browser which is already on 
#               their buglist.
#
# 11/26/94:     Version 1.01: removed 'die''s and instead now feed the
#               nntp error descriptions to the www client
#
# 11/22/94:     Version 1.0: expanded script to include 2 other cartoons
#		distributed by ClariNet: Bizarro and Views of the World.
#               Also added an error page which gives the valid range of 
#               articles if an out-of-range article is somehow requested.
#
# 6/7/94:       Version 0.15: read-comics?today now issues a redirect
#               for non-local sites to GNN's freely-available Dilbert 
#               strip.  NCSA httpd 1.3 generates CGI process killing 
#		messages in response to "Location" tag redirects, but 
#               they can be safely ignored.
#
# 5/19/94:	Version 0.14. Fixed read-comics?today for the case that 
#		the article does not contain an image (such as today's 
#		Dilbert Newsletter.)  Thanks to Ed Kubaitis 
#		<ejk@ux2.cso.uiuc.edu> for reporting the problem and 
#		providing the patch!
#
# 1/21/94:	Version 0.13. Minor change made in how GIF containing 
#		articles are determined.  Now either one of the following
#		need be true: the first word in the subject is "Dilbert:", 
#		or the last word is "(1/1)".
#		
# 1/18/94:	Version 0.12. Added IP checking of domain for servers for 
#		which gethostbyname does not return a FQDN.  Removed 
#		dependency on `hostname` for obtaining the server's
#		hostname.  Replaced references to "clari.feature.dilbert"
#		by $group in the text.
#
# 1/17/94:	Version 0.11. Changed name of script to not interfere
#		with trademark restrictions. (Dilbert is a registered
#		trademark of Scott Adams and United Media).
#		
# 1/16/94:	Version 0.1. Initial release.
#
############################################################################

# Change these variables to suit your environment.
$ip_mask = "129.105";		# You need only change this (to the first 
                                # few numbers of the IP address assigned 
                                # to your domain - e.g., "129.105") if your 
                                # machine does not return a fully qualified 
                                # domain name for $remote_host.  If you 
                                # have no problems resolving FQDNs on your
                                # local network, you should set $ip_mask =
                                # "NNN.NNN"
$ip_mask2 = "165.124";
$ip_mask3 = "199.74";
$domain = "nwu.edu";
$nntphost = "news.acns.nwu.edu";
$dilbert_group = "clari.feature.dilbert";
$bizarro_group = "clari.feature.bizarro";
$worldviews_group = "clari.feature.worldviews";

$dilbert_url = "http://www.unitedmedia.com/comics/dilbert/";
$dilbert_today_url = "http://www.unitedmedia.com/comics/dilbert/todays_dilbert.gif";

############################################################################
# You should not need to change anything after this line.
require 'sys/socket.ph';
require 'ctime.pl';

$version = "1.04";
$date = &ctime(time);
$group = $dilbert_group;	# default group
$hostname = $ENV{'SERVER_NAME'};
$query_string = $ENV{'QUERY_STRING'};
$path_info = $ENV{'PATH_INFO'};
$remote_addr = $ENV{'REMOTE_ADDR'};
$remote_host = $ENV{'REMOTE_HOST'};
$script_name = $ENV{'SCRIPT_NAME'};

if (($query_string eq "")  && ($path_info eq "")) { 
  print <<"EOM";
Content-Type: text/html

<HTML><HEAD>
<TITLE>read-comics, a gateway to the ClariNet comics</TITLE></HEAD>
<BODY><H1>Comics available through ClariNet</H1><HR>
The following comics are available through the ClariNet electronic newspaper:
<ul>
<li><strong>Bizarro</strong>:
    <ul> 
    <li><a href = "ftp://ftp.clarinet.com/help/bizarro">about Bizarro</a>
    <li><a href = "$script_name/bizarro?today">Today's Bizarro comic</a>
    <li><a href = "$script_name/bizarro">Index of Bizarro comics</a>
    </ul>
<p><li><strong>Views of the World</strong>:
    <ul> 
    <li><a href = "ftp://ftp.clarinet.com/help/worldviews/intro">about 
        Views of the World</a> 
    <li><a href = "$script_name/worldviews?today">Today's Views of the World 
        comic</a>
    <li><a href = "$script_name/worldviews">Index of Views of the World 
        comics</a>
    </ul> 
</ul>

Please note that copyright restrictions limit our distribution of this
comic strip to hosts in the <STRONG>$domain</STRONG> domain. 

EOM
  &printlongtail;
  &printtail;
} else {			# Query provided

  if (($remote_host !~ /\.$domain$/) &&
      ($remote_addr !~ /^$ip_mask/) &&
      ($remote_addr !~ /^$ip_mask2/) &&
      ($remote_addr !~ /^$ip_mask3/)) { # Access denied


    if (($path_info =~ /dilbert/) &&
        ($query_string ne "today")) {
 
      print <<"EOM";
Location: $dilbert_url
Content-Type: text/html
 
<HTML><HEAD><TITLE>Dilbert</TITLE></HEAD> <BODY><H1>Dilbert</H1><HR>
Dilbert has moved.
 
EOM
      &printlongtail;
      &printtail;
      exit;
}

    if (($path_info =~ /bizarro/) || 
	($path_info =~ /worldviews/) ||
        ($query_string ne "today")) {

      print <<"EOM";
Content-Type: text/html

<HTML><HEAD><TITLE>read-comics access restricted</TITLE></HEAD>
<BODY><H1>read-comics access restricted</H1><HR> These comics are
distributed by ClariNet.  Copyright restrictions limit our
distribution of this comic strip to hosts in the
<STRONG>$domain</STRONG> domain.

EOM
      &printlongtail;
      &printtail;
} else {

	print <<"EOM";
Location: $dilbert_today_url
Content-Type: text/html

<HTML><HEAD><TITLE>Dilbert</TITLE></HEAD> <BODY><H1>Dilbert</H1><HR>
Dilbert has moved.

EOM
        &printlongtail;
	&printtail;
} # end (query_string ne "today")

} else {			# access allowed

  if (($path_info ne "") && 
      ($path_info ne "/dilbert") && 
      ($path_info ne "/bizarro") && 
      ($path_info ne "/worldviews")) {

    print <<"EOM";
Location: http://$hostname$script_name
Content-Type: text/html

Sorry, that request was not understood.  Please <a href =
"$script_name">try again</a>.

EOM
    exit;
  }

  $group = $bizarro_group if ($path_info =~ /bizarro/);
  $group = $worldviews_group if ($path_info =~ /worldviews/);

  if ((($path_info =~ /dilbert/) || ($path_info eq "")) && ($query_string eq "today")) {
    print <<"EOM";
Location: $dilbert_today_url
Content-Type: text/html
 
<HTML><HEAD><TITLE>Dilbert</TITLE></HEAD> <BODY><H1>Dilbert</H1><HR>
Dilbert has moved.

EOM
    &printlongtail;
    &printtail;
    exit;
}

  if ($path_info =~ /dilbert/) {
    print <<"EOM";
Location: $dilbert_url
Content-Type: text/html
 
<HTML><HEAD><TITLE>Dilbert</TITLE></HEAD> <BODY><H1>Dilbert</H1><HR>
Dilbert has moved.

EOM
    &printlongtail;
    &printtail;
    exit;
}

  &startnntp("$nntphost");
  &read_nntp_header();
  ($first, $last) = &group_cmd();
  &xhdr_cmd($first,$last);

  if ($query_string eq "") {

    print <<"EOM";
Content-Type: text/html

<HTML><HEAD><TITLE>read-comics gateway to $group</TITLE></HEAD>
<BODY><H1>read-comics <em>$group</em> gateway</H1> Please note that
these comic strips are copyrighted and do not pass on copies to
others.  Legitimate access is restricted to hosts in the
<STRONG>$domain</STRONG> domain.

EOM
    &getlinks(@subject);

    print "<HR> This page was automatically generated on $date <HR>\n";
    &printtail;
  } elsif ($query_string eq "today") {
    $last-- if $subject[$#subject] =~ /Dilbert Newsletter/i;
    &printasgif($last);
  } else {			# number provided
    if (($query_string < $first) || ($query_string > $last)) {
      print <<"EOM";
Content-Type: text/html

Sorry, that comic strip is not available.  The valid range for $group is
$first to $last.

EOM
    exit;
    }		
    &printasgif($query_string);
  }				# end number provided

}				# end access allowed
}				# end query provided

sub printlongtail {
  print <<"EOM";
<P> As of April 1st, Dilbert is no longer available through ClariNet.
<A HREF = "$dilbert_url">Dilbert is now available from United Media's Web server</A>.

<P> <A HREF =
"http://www.eecs.nwu.edu/~jmyers/cgi-src/read-comics"><EM>read-comics</EM></A>
- a gateway to the ClariNet comics - is a <A HREF=
"http://hoohoo.ncsa.uiuc.edu/cgi/overview.html">Common Gateway
Interface</A> script written in <A HREF =
"http://www.eecs.nwu.edu/perl/perl.html">Perl</A> which queries the
news server via NNTP, generates a list of hyperlinked articles, and
retrieves and decodes selected articles on-the-fly. <p>

EOM
}

sub printtail {
  print <<"EOM";
This is <A HREF =
"http://www.eecs.nwu.edu/~jmyers/cgi-src/read-comics"\
><EM>read-comics</EM></A>, version <em>$version</em>, written by
<EM><A HREF = "http://www.eecs.nwu.edu/~jmyers/plan.html">Jennifer
Myers</A> </EM></BODY></HTML>

EOM
}

sub printasgif {
  local($name) = @_;
  local(@txt) = &body_cmd($name);
  if (grep(/^Content-Type: image\/gif/i, @txt)) {
    $_ = shift(@txt) until $_ =~ /^Content-Type: image\/gif/i;
    print "Content-Type: image/gif\n\n";
    $_ = shift(@txt) until $_ = /^$/;
    &decode64initialize;
    while ($_ = shift(@txt)) {
      print &decode64($_);
    } 
  } else {
    print "Content-Type: text/html\n\n";
    print "No image found!\n";
    exit;
  }
}

sub decode64initialize {
  @code64 = ('A'..'Z', 'a'..'z', '0'..'9', '+', '/');
  grep($bin64{$code64[$_]} = unpack('B6', pack('C', $_ * 4)), 0 .. 63);
}

sub decode64 {
  local($bits) = join('', grep($_ = $bin64{$_}, $_[$[] =~ /./g));
  pack('B' . (length($bits) & ~7), $bits);
}

sub getlinks {
  local(@articles) = @_;
  local(@i);
  print "<UL><LI><A HREF = \"$script_name$path_info?today\"\\\n";
  print ">Today's cartoon</A> (see below for title)</UL>\n";
  print "<H2>Archived:</H2>";
  print "<UL>\n";
  while ($_ = shift(@articles)) {
    split;
    $num = shift(@_);
    @subj = @_;
    print "<LI> <A HREF=";
    print "\"$script_name$path_info?$num\">@subj</A>\n";
  }
  print "</UL>";
}

sub body_cmd {
  local($name) = @_;
  local(@ret);
  print NNTP "BODY $name\n";
  $_ = <NNTP>;
  if (!/^222 /) {		# body cmd problems
    &quit_cmd(1);
  }
  @ret = &getlines();       
  return(@ret);
}

sub xhdr_cmd {
  local($a,$b)=@_;
  print NNTP "XHDR Subject $a-$b\n";
  $_ = <NNTP>;
  if (!/^221 /) {		# xhdr cmd problems
    if (/^500 /) {
      &manual_xhdr_cmd($a,$b);
    } else {
      &quit_cmd();
    }
    return;
  }
  @subject = &getlines();      
}

sub manual_xhdr_cmd {
  local($a,$b) = @_;
  local($i,@s,$j);
  $#subject = $[;
  foreach $i ($a .. $b) {
    print NNTP "HEAD $i\n";
    $_ = <NNTP>;
    if (/^221 /) {
      @s = grep(/^Subject: /,&getlines());
      $s[0] =~ /^Subject: (.*)/;
      push(@subject,"$i $1");
    } else {
      print "$_";
    }
  }
}

sub getlines {
  local(@ret);
  while (<NNTP>) {
    if (/^\./ && (!/^\.\./)) {
      chop;
      last;
    }
    s/\015//g;
    push(@ret,$_);
  }
  return(@ret);
}

sub quit_cmd {
  local($code) = @_;
  print NNTP "QUIT\n";
  $_ = <NNTP>;
  exit($code);
}

sub group_cmd {
  print NNTP "GROUP $group\n";
  $_ = <NNTP>;
  split;
  ($code,$num,$first,$last,$group) = @_;
  if ($code != 211) {		# group cmd problems
    &quit_cmd(1);
  }
  return($first,$last);
}

sub dokill {
  kill(9,$child) if $child;
}

sub startnntp {
  local($name) = @_;
  $SIG{'INT'} = 'dokill';
  $sockaddr = 'Sna4x8';
  ($n,$aliases,$proto) = getprotobyname('tcp');
  ($n,$aliases,$port) = getservbyname('nntp','tcp');
  ($n,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
  ($n,$aliases,$type,$len,$thataddr) = gethostbyname($name);
  $this = pack($sockaddr,&AF_INET,0,$thisaddr);
  $that = pack($sockaddr,&AF_INET,$port,$thataddr);
  unless (socket(NNTP,&PF_INET,&SOCK_STREAM,$proto)) {
    print "Content-Type: text/html\n\n";
    print "Error from news server $nntphost:<p>socket: $!\n";
    exit;
  }
  unless (bind(NNTP,$this)) {
    print "Content-Type: text/html\n\n";
    print "Error from news server $nntphost:<p>bind: $!\n";
    exit;
  }
  unless (connect(NNTP,$that)) {
    print "Content-Type: text/html\n\n";
    print "Error from news server $nntphost:<p>connect: $!\n";
    exit;
  }
  select(NNTP); $|=1;
  select(STDIN); $|=1;
  select(STDOUT); $|=1;
}

sub read_nntp_header {
  while (<NNTP>) {
    last if (/^200 /);
    last if (/^201 /);
    exit(1) if (/^400 /);
  }
}