[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: LYNX-DEV patch-o-matic
|
From: |
Jim Spath (Webmaster Jim) |
|
Subject: |
Re: LYNX-DEV patch-o-matic |
|
Date: |
Sun, 18 May 1997 10:26:37 -0400 (EDT) |
On Sun, 18 May 1997, Jim Spath (Webmaster Jim) wrote:
> On Sun, 18 May 1997, Paulo JS Rodrigues wrote:
> > through Netscape it didn't work: I tried lynx after and found out why: you
> That's on my to-do list. At first, I thought it would be amusing to
> have Netscape/Microsoft users be rejected the way many pages reject
> Lynx users... But that makes patch-o-matic less useful.
Ok, I've modified the startup logic so that other browsers are
recognized. I tested this from Netscape as well as Chimera.
The source is attached, for good measure.
------
<http://www.cs.indiana.edu/picons/db/users/us/md/lib/bcpl/jspath/face.xbm>
Marvin the Paranoid Android says:
You realise this is going to be a complete waste of time don't you?
#!/usr/local/bin/perl
# patch-o-matic.cgi -- produce patch files automatically on request
# author: j.e. spath <address@hidden>
# tweaked: klaus weide
# last: Thu Apr 5
# Tue Apr 8 10:16:56 MDT 1997
# revised: Sun May 18 09:46:22 EDT 1997 : allow non-Lynx "agents"
use CGI ':standard';
use IPC::Open2;
use Symbol;
use sigtrap qw(stack-trace untrapped normal-signals error-signals);
$BASE='2.7-PL.1';
$MAJOR='2.7';
# Changed location (testing new version) from: $PRCS='/usr/local/bin/prcs';
$PRCS='/home/kweide/bin/prcs';
$PROJECT='Lynx';
$REPO='/usr/ns-home/docs/lynx/src/PRCS';
$REV='2.7.1ac-0.';
$SOFTWARE='lynx';
$LYNXDIRNAME='lynx2-7-1'; # called archdir in debit, lynxname in Lynx makefile
$LOCKDIRNAME=$REPO.'/.locks';
$LOGFILE='/home/kweide/kw-patch-o-matic.log';
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$default_patch_type = '-c';
&check_locks;
if ( ! param() ) {
# First time through
# For now, set umask to 000 to prevent PRCS locking problems which may
# occur in spite of the &check_locks locks - until a new version of prcs
# gets installed that hopefully fixes the problems. - kw
umask(0);
$level=`$PRCS info --repository=$REPO --force --revision=$REV@ $PROJECT`;
($a, $our_level, $c) = split / /, $level;
# set the target for today:
$our_level_prcs_major = $our_level;
$our_level_prcs_major =~ s#(.+)\.\d+$#$1#;
$our_level_prcs_minor = $our_level;
$our_level_prcs_minor =~ s#.+\.(\d+)$#$1#;
$prev_level_prcs_minor = $our_level_prcs_minor - 1;
# Let's look for Lynxes we know
$ua = user_agent();
$_ = $ua;
if (/^Lynx/) {
($lynx_ver) = split(' ', $ua); # only use first word
$lynx_ver =~ s#Lynx/(.*)#$1#; # ..and of that, only the part after "Lynx/"
$lynx_ver =~ s#\(.*$##; # ..and discard comments starting with '('
$lynx_ver =~ s#-Styles$##; # ..and discard a possible "-Styles" suffix.
$lynx_major = $lynx_ver;
$lynx_major =~ s#(\d\D\d)(.*)#$1#;
$lynx_minor = $lynx_ver;
$lynx_minor =~ s#\d\D\d(.*)#$1#;
$old_level="$lynx_major$lynx_minor";
$new_level=$our_level;
} else {
# !Lynx
$old_level="Your-Old-Level-Here";
$new_level=$our_level;
}
# Show 'em what they got
if ($lynx_major ne "") {
print header(-vary=>'user-agent', -status=>'200 Welcome');
print start_html(
-title=>'Patch-O-Matic [TM]',
-rel_help=>'http://www.slcc.edu/lynx/html/patch_help.html',
);
print "<h1>Welcome Lynx $lynx_major User!</h1>";
if ($lynx_major ne $MAJOR) {
print
"<h2>You are running an older version of Lynx.</h2>\n";
$old_level = "$our_level_prcs_major.$prev_level_prcs_minor";
} elsif ($lynx_minor eq '') {
print
"<h2>You have the base release.</h2>\n";
$old_level = $BASE; # repository name for original Lynx 2.7
$default_patch_type = '-q'; # prevent excessive output by default
} else {
print
"<h2>Your current patch level is: $old_level</h2>\n";
}
} else {
print header(-vary=>'user-agent', -status=>'200 Welcome');
print start_html(
-title=>'Patch-O-Matic [TM]',
);
print "<h1>Howdy Stranger [$ua User]!</h1>";
print "<a href=\"http://www.slcc.edu/lynx/html/patch_help.html\";>(Click
Here For More Help)</a><br>";
$old_level = $BASE; # repository name for original Lynx 2.7
$default_patch_type = '-q'; # prevent excessive output by default
}
# Say something helpful ("helpful")
print
'This form can be used to obtain patches for ',
'the latest development version of <strong>Lynx</strong>, ',
"\n",
'the World Wide Web text browser. ',
"\n",
'If you wish the base release or other help, please visit ',
'<a href="http://lynx.browser.org/";>http://lynx.browser.org/</a>',
"\n", p,
start_form(-method=>"GET"),
"\n", p;
# Show 'em what we got
print
"<h2>Our current patch level is: $our_level</h2>",
"\n", br,
'Patch from: ', textfield(-name=>'old_level', -default=>$old_level),
"\n", br,
'Patch to: ',textfield(-name=>'new_level', -default=>$new_level),
"\n", br,
'Type of diff output: ',
"\n", br,
radio_group(-name=>'patch_type',
-values=>['-c', '-u', '-q'],
-label=>[' Context \'-c\'', ' Unified \'-u\'', ' List filenames
only \'-q\''],
-labels=>{'-c'=>' Context \'-c\'', '-u'=>' Unified \'-u\'',
'-q'=>' List filenames only \'-q\''},
-default=>$default_patch_type),
"\n", br,
'Output compression: ',
radio_group(-name=>'compress',
-values=>['y', 'n'],
-labels=>{'y'=>' Yes ', 'n'=>' No '},
-default=>'n'),
"\n", br,
'Include new files: ',
radio_group(-name=>'new',
-values=>['y', 'n'],
-labels=>{'y'=>' Yes ', 'n'=>' No '},
-default=>'y'),
"\n", br,
'List From patch level comments only: ',
radio_group(-name=>'info',
-values=>['y', 'n'],
-labels=>{'y'=>' Yes ', 'n'=>' No '},
-default=>'n'),
"\n", p,
submit,
"\n", br,
'[Lynx users can download with the <strong>d</strong> key on the
submit button.]',
end_form,
;
} else {
# Not first time through; let's see what the variables are:
$client_level=param('old_level');
$server_level=param('new_level');
$diff_flags=param('patch_type');
$compression=param('compress');
$info_flag=param('info');
$new_flag=param('new');
# log it
open (LOG, ">>$LOGFILE");
print LOG "$year/$mon/$mday $hour:$min ";
print LOG
'user_agent=', user_agent(), ' ',
'remote_host=', remote_host(), ' ',
'client=', $client_level, ' ',
'server=', $server_level, ' ',
'diff_flags=', $diff_flags, ' ',
'compression=', $compression, ' ',
'info_flag=', $info_flag, ' ',
'new_flag=', $new_flag, ' ',
'START',
"\n";
if ($new_flag eq "y") {
$new_option = "--new";
} else {
$new_option = "";
}
# Security: check for shell spoofing characters
"$PRCS$REPO$client_level$server_level$PROJECT" =~ /[<>|~#{}()&!`\\"'%\$]/ &&
&shell_spoof_exit;
# For now, set umask to 000 to prevent PRCS locking problems which may
# occur in spite of the &check_locks locks - until a new version of prcs
# gets installed that hopefully fixes the problems. - kw
umask(0);
if ($info_flag eq "y") {
$result=`$PRCS info --long-format --force --repository=$REPO
--revision=$client_level $LYNXDIRNAME/$PROJECT 2>/dev/null `;
$prcs_status = ($? >> 8); # Hmmm; PP p134
&exit_after_command_failure($? & 255, $result eq "")
if ((! $prcs_status && $? & 255) || $result eq "");
if ($prcs_status eq 0) {
print header(-type=>'text/plain',
);
print $result or &exit_after_IO_failure("STDOUT", 'print $result', 0);
&log_before_exit(__LINE__, $?, "none" ,"PRCS info OK");
} else {
print header(-type=>'text/html', -status=>'404 Pas trouvé');
print "The program has failed. We are very sorry.\n";
&log_before_exit(__LINE__, $prcs_status, "(none)" ,"PRCS info failed");
}
} else {
# not info only
# This is only for checking if everything is ok and whether there are
# any differences; use -q to avoid excessive output here.
# The $result variable will be used only if the user requested
# patch_type is "-q".
$result=`$PRCS diff --force $new_option --repository=$REPO
--revision=$client_level --revision=$server_level $LYNXDIRNAME/$PROJECT -- -q
2>&1 `;
$prcs_status = ($? >> 8); # Hmmm; PP p134
&exit_after_command_failure($? & 255, $result eq "")
if ((! $prcs_status && $? & 255) || $result eq "");
if ($prcs_status eq "0") {
if ("$client_level$server_level" !~ /@/) { # normal case, no /@/in versions
print header(-type=>'text/html', -status=>'400 You goofed...',
'-cache-control'=>'max-age=' . 24*3600);
} else {
print header(-type=>'text/html', -status=>'400 Makes not difference...',
'-cache-control'=>'max-age=60');
}
print hr;
print "The patches coincide. Please try again.\n";
&log_before_exit(__LINE__, 400, "none", "No differences");
}
# The good one:
if ($prcs_status eq "1") {
if ($diff_flags ne "-q") {
$|=1;
if (!defined($op=open(PRCSPROC,"-|"))) { # open failed
&exit_after_IO_failure("PRCSPROC", "open", 1);
}
if (!$op) { # Child process
exec "$PRCS diff --force $new_option" .
" --repository=$REPO" .
" --revision=$client_level" .
" --revision=$server_level" .
" $LYNXDIRNAME/$PROJECT" .
' -- ' . $diff_flags or exit 1;
} else { # Our main process
if ($compression eq "y") {
if (!defined($opgz=open(GZPROC,"|-"))) { # open failed
kill "INT", $op or kill 9, $op;
&exit_after_IO_failure("GZPROC", "open", 1);
}
if (!$opgz) { # Compressor child process
umask(022);
exec '/usr/local/bin/gzip', '-' or exit 77;
}
}
if (!defined($opstrip=open(STRIPPROC,"|-"))) { # open failed
kill "INT", $op or kill 9, $op;
if ($compression eq "y") {
kill "INT", $opgz or kill 9, $opgz;
}
&exit_after_IO_failure("STRIPPROC", "open", 1);
}
if (!$opstrip) { # Child process
if ($compression eq "y") {
open(STDOUT, ">&GZPROC")
or &exit_after_IO_failure("GZPROC", "dup-open by
child", 0);
}
exec "/home/kweide/bin/strip-prj-from-diff"
or exit 1;
}
if (eof(PRCSPROC)) {
print header(-type=>'text/plain',
-status=>'500 Premature end of data'
);
kill "INT", $op or kill 9, $op;
kill "INT", $opstrip or kill 9, $opstrip;
if ($compression eq "y") {
kill "INT", $opgz or kill 9, $opgz;
}
&exit_after_IO_failure("PRCSPROC", "eof", 0);
}
&print_header($compression, "$client_level$server_level");
while (<PRCSPROC>) {
print STRIPPROC $_ or &exit_after_IO_failure("STRIPPROC",
"print", 0);
}
if (!(eof(PRCSPROC)) || ($? ne 256)) {
close PRCSPROC;
$problems = 1;
&log_before_exit(__LINE__, $?>>8, $? & 255, "...closed
PRCSPROC...");
}
if (!(close STRIPPROC) || $?) {
&log_before_exit(__LINE__, $?>>8, $? & 255, "...closed
STRIPPROC...");
$problems = 1;
}
if ($compression eq "y" and !(close GZPROC) || $?) {
$problems = 1;
&log_before_exit(__LINE__, $?>>8, $? & 255, "...closed
GZPROC...");
}
if ($problems) {
&log_before_exit(__LINE__, $?, $? & 255,"OK response sent but
see above");
} else {
&log_before_exit(__LINE__, 200, "none", "OK");
}
exit;
}
}
if ($compression eq "y") {
$WTR = gensym();
$RDR = gensym();
$pid = open2($RDR, $WTR, '/home/kweide/bin/strip-prj-from-diff |
/usr/local/bin/gzip -');
print $WTR $result;
close ($WTR);
&print_header($compression, "$client_level$server_level");
while (<$RDR>) {
if (!(print "$_")) {
kill "INT", $pid or kill 9, $pid;
&exit_after_IO_failure("STDOUT", "print", 0);
}
}
&log_before_exit(__LINE__, 200, "none" ,"Probably OK (gzipped info)");
}
if ($compression eq "n") {
&print_header($compression, "$client_level$server_level",
length($result));
print $result;
&log_before_exit(__LINE__, 200, "none", "Probably OK (info)");
}
}
if ($prcs_status ge "2") {
print header(-type=>'text/html', -status=>'404 Pas trouvé');
print hr;
print "The patch generation failed. We are very sorry.\n";
# print $result;
print p; # What's this???
&log_before_exit(__LINE__, $prcs_status, "none" ,"Not Found");
}
} # end of "diff"
close (LOG);
exit 0;
}
sub print_header {
my($compression, $check_for_at, $conlen) = @_;
if ($conlen) {
@conlen = ('-content-length', $conlen);
}
if ($compression eq "y") {
if ("$check_for_at" !~ /@/) { # normal case, no /@/in versions
print header(-type=>'text/plain',
'-content-encoding'=>'gzip',
'-content-disposition'=>
'file; filename="' .
"lynx$client_level--$server_level" . '.diff.gz"',
'-cache-control'=>'max-age=' . 5*24*3600,
-etag=>'W/"' . "$client_level--$server_level" . '.gz"'
);
} else { # don't cache, or not for long...
print header(-type=>'text/plain',
'-content-encoding'=>'gzip',
'-content-disposition'=>
'file; filename="' .
"lynx$client_level--$server_level" . '.diff.gz"',
-pragma=>'no-cache',
'-cache-control'=>'max-age=' . 5*60);
}
} else {
if ("$check_for_at" !~ /@/) { # normal case, no /@/in versions
print header(-type=>'text/plain',
@conlen,
'-content-disposition'=>
'file; filename="' .
"lynx$client_level--$server_level" . '.diff"',
'-cache-control'=>'max-age=' . 5*24*3600,
-etag=>'W/"' . "$client_level--$server_level" . '"'
);
} else { # don't cache, or not for long...
print header(-type=>'text/plain', -pragma=>'no-cache',
@conlen,
'-content-disposition'=>
'file; filename="' .
"lynx$client_level--$server_level" . '.diff"',
'-cache-control'=>'max-age=' . 5*60);
}
}
}
sub shell_spoof_exit {
print header('-content-length'=>0, -status=>'205 That won\'t work.',
-location=>'file:///');
&log_before_exit(__LINE__, 205, "none", "Invalid special chars!");
exit;
}
sub log_before_exit {
my($line, $status, $signal, $text) = @_;
print LOG "$year/$mon/$mday $hour:$min ";
print LOG
'user_agent=', user_agent(), ' ',
'remote_host=', remote_host(), ' ',
'client=', $client_level, ' ',
'server=', $server_level, ' ',
'diff_flags=', $diff_flags, ' ',
'compression=', $compression, ' ',
'info_flag=', $info_flag, ' ',
'new_flag=', $new_flag, ' ',
'END ',
"line=$line ",
"status=$status ",
"signal?=$signal ",
$text,
"\n";
}
sub exit_after_command_failure {
my($signal, $empty) = @_;
if ($signal || !$empty) {
print header(
'-status'=>'500 Killed',
);
print "Signal $signal.";
&log_before_exit(__LINE__, 500, $signal, "Killed!");
} else {
print header(-type=>'text/plain', -status=>'404 Nicht gefunden');
print "The program has failed to generate info, sorry.\n";
&log_before_exit(__LINE__, 404, $signal, "No output from command.");
}
exit 1;
}
sub exit_after_IO_failure {
my($fd, $operation, $header_flag) = @_;
if ($header_flag) {
print header('-type'=>'text/plain',
'-status'=>'500 ' . $operation . " failed",
);
} else {print "exit_after_IO_failure header would go here...............\n"}
print "Internal error, sorry...\n\n ",
$operation . " on " . $fd . " failed.\n";
&log_before_exit(__LINE__, 500, "(none)" , $operation . " on " . $fd . "
failed.");
exit 1;
}
sub check_locks {
$r_lock_dev = stat $LOCKDIRNAME.'/Lynx.readers';
$w_lock_dev = stat $LOCKDIRNAME.'/Lynx.writers';
if ($r_lock_dev eq 1 or $w_lock_dev eq 1) {
print header(
'-content-length'=>0,
'-status'=>'409 Conflict with ongoing transaction.',
);
print "We're sorry, but there is an ongoing transaction. \n",
"Please try again in a few minutes. \n",
"<p>\n",
"If you wish the base release or other help, please visit ",
"<a href=\"http://lynx.browser.org/\";>http://lynx.browser.org/</a>",
"\n";
exit 0;
} else {
# print "Proceed!\n";
return;
}
}