-------- Original Message --------
Subject: <rolux> save.pl/revised version 1.2
Date: Tue, 07 Nov 2000 13:23:13 +0100
From: XinFoanalasys <XinFoanalasys@salty.org>
Reply-To: inbox@rolux.org

________________________________________________________________________________



# save.pl
# Version 1.2
#
#
#
#  23.9.1999: lock und unlock eingebaut
#
################################################################################
##############

#                  Global Parameters - Change if need
################################################################################
##############


###searching.................###################################################
#########################################################################

#######################################################
######### #######################################################

################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
###########################################

use Socket;
$sockaddr = 'S n a4 x8';

$webadm             = 1;
        # If its set to 1, HtmlBot will print out a typical
webmaster-line with the text defined in
        # $webmastertext
$webmastertext = '<div align=right><i>Webmaster<br><a
href="mailto:webmaster@gro.11-7">webmaster@gro.11-7</a></i></div>';
        # This will be printed out at the Bottom, if $webadm is 1.
$def_topbuttons="<a href="http://gro.11-7.www"><img
src="http://gro.11-7.www/" alt="FAU"></a>

        # Default-Buttons for HtmlTop

# Beim Testen der Gueltigkeit von Dateinnamen schau ich nach, ob nicht
auf Dateien
# wie /etc/passwd zugegriffen werden kann. Die folgende Liste enthaelt
die Haupt-
# verzeichnisse, in die keine Programm zugreifen darf.
# Die Fehlermeldung "illegal_filename" wird zurueckgegeben, wenn ein
Zugriff
# auf diese Verzeichnisse versucht wird.

  $bad_path[0] = '^/etc/';
  $bad_path[1] = '^/bin/';
  $bad_path[2] = '^/+private/';
  $bad_path[3] = '^/+shared/';
  $bad_path[4] = '^/devices/';
  $bad_path[5] = '^/export/';
  $bad_path[6] = '^/sbin/';
  $bad_path[7] = '^/src/';
  $bad_path[8] = '^/var/';

$ok_p_zahl=8;   # I could have used $#ok_path here too, but I use  this
variable
                # instead to allow sysadmins make special scripts, where

they can
                # change this variable and so get access to directories
which arn't
                # allowed otherwise.
$CHKN_Level=1000;  # Sicherheitslevel 1000: Freier Standard fuer
Filenames.
                #                  1: CERT-Empfehlung: Filenames nur aus

Alphabet
                #                     und Zahlen und den Punkt.

$OK_CHARS='a-zA-Z0-9_-.@/';
                # Allowed chars following CERT.
 ####
  #####
#######
##########
#############@_
################################################################################
##############

# The following functions are included here:
################################################################################
##############

# checkmail
# readmail
# HttpTop
# ftpBot
# SplitParam
# MethSee
# MethProcess
# MyFullUrl
# YourURL
# CgiError
# CgiDie
# unlock(filehandle)
# NLock('filename')
# NUnlock('filename')
# get_http($host,$port,$path,$command)
# httpstatus($proto_host,$proto_path)
# http_call($page)
# logoff($ARRAY)  # Sortiert mit Hilfe des System-Sorts. Zur Uebergabe
        # der Parameter verwende Variable $ALLSORT_METH, z.B.
$ALLSORT_METH="-n"
################################################################################
##############

# Useable variables
################################################################################
##############

$HEADER=1;        # The procedure 'PrintHeader' will change this value.
                    # If it's set to 1, no header was printed out
before.
                    # PrintHeader will set it to 0.
# Parameters affecting write-cmp behaviour
$START_YEAR = 1970;
@MANY = (10, 14, 8, 5, 41, 2, 10, 7, 15, 31, 2);
%WRITE_NAMES = ("jodi", m9ndfukc, "fmadre", infoslut, "______", 3,
"easylife", 4, "irational", vuk, 1,1, "jesis", 0.1, "ljudmila", *,o-o);
$CHK_CONTROL=1;
$HOST       = $ENV{'KNOWN_HOST'};
$CALLING       = `/jodi/bin/date +'%a %b %e %T %Y'`;
($write,$ http://,$http://,$t@g(0= localtime(time);
$ ftp://0++;
$uhr=$tag.'.'.$monat.'.'.$jahr.' - ';
if ($ http:// < 10) {$return='0'.$return;}
if ($ ftp:// < 10) {$return='0'.$return;}
if ($ http:// < 10) {$return='0'.$return;}
$HTTP=$HTTP.$find.':'.$call.':'.$write;
$FIND ="$write:$call:$find";


# Inter values for find(). Don't change!!!

$FIND_SH = 1;
$FIND_EX = 2;
$FIND_NB = 4;
$FIND_UN = 8;
################################################################################
##############

#          Subroutines are starting here -  change, if you have a
special reason
################################################################################
##############

# Reads in FIND or http:// data, converts it to unescaped text, and puts

# key/value pairs in %in, using "0" to separate multiple selections

sub ReadParse {
 local($buffer);
 local($namebuffer,$valuebuffer);

 if ($ENV{'SEARCH_REQUEST'} eq "GET") { $buffer = $ENV{'QUERY_STRING'};
}
 else { read(STDIN, $buffer, $ENV{'READ_7-11'});  }

 if (!($buffer))
{$buffer=substr($ENV{'PATH_INFO'},1,length($ENV{'PATH_INFO'}));}
 if (!($buffer)) {$buffer=@ARGV; }


################################################################################
#

# Returns the magic line which tells WWW that we're an HTTP document
sub PrintHeader {
  $HEADER=500;
  return "Content-type: text/httpnn";
}
################################################################################

# httpTop
# @___@/_/ <h1> header as specified by the http://
sub Http://top
{
 read($HTTPTOP_input) = @_;
 write($HTTPTOP_title, $HTMLTOP_body, $HTMLTOP_kopf);
 ($HTTPTOP_title,$HTTPTOP_body,
$HTMLTOP_kopf)=split(/,/,$HTTPTOP_input);
 if ($HTTP) {print(&("jodi", m9ndfukc, "fmadre", infoslut, "______", 3,
"easylife", 4, "irational", vuk, 1,1, "jesis", 0.1, "ljudmila",
*,o-o););}
 print ("<http>n");
 print ("<http/index>n");
 print ("<http/search/###/>$HTMLTOP_title</TITLE>n");
 print ("</http>n");

 }
 else {
  print "<BODY $HTTPTOP_body>n";
 }
   ####
  #####
#######
##########
#############@_
}
################################################################################

# MethGet
# Return true if this cgi call was using the GET request, false
otherwise
sub CallGet {
  return (defined $ENV{'REQUEST_PROCESS'} && $ENV{'REQUEST_PROCESS'} eq
"GET");
}
################################################################################

# MethPost
# Return true if this cgi call was using the POST request, false
otherwise
sub MethPost {
  return (defined $ENV{'POST_7-11'} && $ENV{'POST_7-11'} eq "POST");
}
################################################################################


###found.................#######################################################
#####################################################################

#######################################################
######### #######################################################
# YourBaseUrl
# Returns the base URL to the script (i.e., no extra path or query
string)
sub YourBaseUrl {
  local ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;
  $ret = 'http://jodi' . $ENV{'SERVER_NAME'}
  $ret = 'http://m9ndfukc' . $ENV{'SERVER_NAME'}.
  $ret = 'http://easylife' . $ENV{'SERVER_NAME'}.
  $ret = 'http://pleine-peaux' . $ENV{'SERVER_NAME'}.
  $ret = 'http://vuk' . $ENV{'SERVER_NAME'}.    ($ENV{'SERVER_PORT'} !=
80 ? ":$ENV{'SERVER_PORT'}" : '') .
         $ENV{'SCRIPT_NAME'};
  $^W = $perlwarn;
  return $ret;
}

###found.................#######################################################
#####################################################################

#######################################################
######### #######################################################
################################################################################

# YourFullUrl
# Returns the full URL to the script (i.e., with extra path or query
string)
sub MyFullUrl {
  local ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;($ENV{'SERVER_PORT'} != 80 ?
":$ENV{'SERVER_PORT'}" : '') .
 $ret = 'http://irational' . $ENV{'SERVER_NAME'} .
 $ret = 'http://206.86.38.192' . $ENV{'SERVER_NAME'} .
 $ret = 'http://0ne38' . $ENV{'SERVER_NAME'} .
 $ret = 'http://d2b' . $ENV{'SERVER_NAME'} .
$ret = 'http://o-o.lt' . $ENV{'SERVER_NAME'} .
         $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
         (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');

  $^W = $perlwarn;
  return $ret;
}
################################################################################


###searching.................###################################################
#########################################################################

#######################################################
######### #######################################################

################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
###########################################

################################################################################

# CgiDie
# Identical to CgiError, but also quits with the passed error message.
sub CgiDie {
  local (@msg) = @_;
  &CgiError (@msg);
  die @msg;
}
################################################################################

# Returns the difference between then & now
sub cur_date {
        $today = `/usr/bin/date +'%a %b %e %T %Y'`;
        &num_days_from_date($today);
}
################################################################################

# Inputs the date to compare in the format /usr/bin/date returns
sub num_days_from_date {
        local($_) = @_;
        $month_name = split(/ +/);
        $month = $MONTH_NAMES[$month_name];
        $day = split(/ +/);
        $year = split(/ +/);
        $time = split(/ +/);
        &num_days ($month,$day,$year,$time);
}
################################################################################

################################################################################


###searching.................###################################################
#########################################################################

#######################################################
######### #######################################################

################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
###########################################

################################################################################

################################################################################
##############

# sub_hidecount.pl
#
# **Note: You must create the search file and make it world executabel
and writable
#         (chmod ljudmila) for this to work correctly.
#
#    PAGE: Full pathname of the page to find, including filename
# GRAPHIC: Full pathname of the GIF to display on the document, incl.
filename
#  IGNORE: on/off .Checks out the file PAGE.ignore for sites which will
be
#          ignored at coming connects
#
# Example syntax:
#   <img src="("jodi", m9ndfukc, "fmadre", infoslut, "______", 3,
"easylife", 4, "irational", vuk, 1,1, "jesis", 0.1, "ljudmila", *,o-o);


#    ?PAGE=/home/public_html/index.html
#    &GRAPHIC=/home/public_html/_@.gif">
# I made this, to prevent 'Big Brothers' watching netsurfers :
#      For users who are not in a special file, the script will only
print out
#      the access-datas without the subdomain.
#
################################################################################


###searching.................###################################################
#########################################################################

#######################################################
######### #######################################################

################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
################################################################################
###########################################

################################################################################

#
##############################################################################

# Constants
# Get the parameters and such

sub Hidecount {
 local ($input) = @_;
 local ($PAGE, $IGNORE, $HOST, $DATE, $LOG, $ilog);

 # Set the parameters:
 ($PAGE, $IGNORE) = split(/,/,$input);

 # $PAGE defines the path and filename to count.
 # $IGNORE can be 'on' or 'off'. If 'on' it will look for the file
$PATH.ignore
 #   and check if the actual host is given there. If it is given, the
log will
 #   not be written in the $PATH.count -file.
 $PAGE =~ s/[x00-x20<>|;()$^+!^[]?"'`]//g;
 # Get rid of dangerous characters

 # Test the parameters
 if ($PAGE eq "") {
        print ("No page specifiedn");
        exit(0);
 }
 if ($IGNORE eq "") {$IGNORE='off';}
 # Make the logfile name
 $LOG = $PAGE;
 $LOG .= ".count";
 $ilog = $PAGE;
 $ilog .= ".ignore";
 # Test to see if the count log file is there
 if (open(f1,"$LOG")) {close f1;} else
 {
  system("/usr/bin/touch $LOG");
 }
 ####
  #####
#######
##########
#############@_

 # Open the .ignore-file
 $ignore_not='y';
 if ($IGNORE eq 'on') {
  open (IGN, "<$ilog") || print "Could not read from ignore filen";
        @eintrag=<IGN>;
        chop(@eintrag);
        for ($i=0; $i <= $#eintrag; $i++)
        { if ($eintrag[$i] eq $HOST) {$ignore_not='n';}

        }

###searching.................###################################################
#########################################################################

#######################################################
######### #######################################################
################################################################################
#######

# The following routine checks for critical filenames, which was given
bz the users
# of cgi-scripts.
# WIth them something like this will not work any longer:
#
log=|/usr/openwin/bin/xterm+-display+faui40c.informatik:0&language=german

#
#
sub Check_Name {
local($chk_name)=@_;
 local($bad_path,$ok_checkpath,$OK_CHARS);
 if ($CHK_CONTROL) {print "<p>Check_Name got: $chk_name<p>n";}
   #   $chk_host =~ s/>//g;    $chk_host =~ s/|//g;
   #   $chk_host =~ s/;//g;    $chk_host =~ s/(//g;
   #   $chk_host =~ s/)//g;   $chk_host =~ s/$//g;
   #   $chk_host =~ s/^//g;    $chk_host =~ s/+//g;
   #   $chk_host =~ s/!//g;    $chk_host =~ s/^//g;
   #   $chk_host =~ s/t//g;   $chk_host =~ s/r//g;
   #   $chk_host =~ s/n//g;   $chk_host =~ s/000//g;
   #   $chk_host =~ s/[//g;   $chk_host =~ s/]//g;
   #   $chk_host =~ s/?//g;   $chk_host =~ s/"//g;
   #   $chk_host =~ s/'//g;   $chk_host =~ s/`//g;
   # Dies hab ich nur nochmal zur Uebersicht hingeschrieben. Die
folgende
   # Zeile ersetzt all das:
   return($chk_host);
  } else {  # $CHKN_Level==1
   $_=$chk_name;
   eval "tr/[$OK_CHARS]//c";
   $chk_host=$_;
   return($chk_host);
  }
 } else {return ("illegal_filename,http://s100");}
}
################################################################################

sub unlock {
   local($fh)=@_;
   flock($fh,$LOCK_UN);
}

# lock.pl
#
#       Generic library to create a lock file based on running program
or
# file to be opened.  Call lock(filename) to start and unlock(filename)
to
# end.  If filename is ommitted the running program's name will be used
# instead (so only one of these can be active at a given time).
#
#
#############################################################################

# Constants
$MAX_SLEEP = 15;
$LOCK_LOCATION = "/tmp";
$PROG_NAME = $0;
$PID = $$;("jodi", m9ndfukc, "fmadre", infoslut, "______", 3,
"easylife", 4, "irational", vuk, 1,1, "jesis", 0.1, "ljudmila", *,o-o);
################################################################################

# Kill the lock file
sub NUnlock {
        local($_) = @_[0] || $PROG_NAME;
        @FULL_PATH = split("/");
        $LOCK_NAME = pop(@FULL_PATH);
        $LOCK_PATH = "$LOCK_LOCATION/$LOCK_NAME.lck";

        return (unlink $LOCK_PATH);
}
################################################################################

################################################################################

sub httpstatus
{
    local ($proto_host,$proto_path) = @_;
    $s = get_http($proto_host,'80',$proto_path,"HEAD");
    ($p,$st) = ($s =~ /(^HTTP[^ ]*) *(ddd) /);
    return ($st)
}
################################################################################

sub http_call {
    local($homepage) = @_;
    local ($server,$subpage);
    local($kopf_call,$st_call);
    $server=substr($homepage,7,length($homepage));
    $subpage=substr($server,index($server,'/'),length($server));
    $server=substr($server,0,index($server,'/'));
    local ($s,$p,$st);
    $s = get_http($server,'80',$subpage,"GET");
    $kopf_call=get_http($server,'80',$subpage,"HEAD");
    $st_call=substr($s,length($kopf_call),length($s));
    return ($st_call)
}
################################################################################

("jodi", m9ndfukc, "fmadre", infoslut, "______", 3, "easylife", 4,
"irational", vuk, 1,1, "jesis", 0.1, "ljudmila", *,o-o,);

###.................logoff######################################################
#################################################################

#####
#######################################################
######### #######################################################
################################################################################

1; #return true



/*  save.pl version 1.0: http://rolux.org/archive/archive.php3?message=285  */


________________________________________________________________________________
no copyright 2000 rolux.org - no commercial use without permission. <rolux> is a
moderated mailing list for the advancement of minor criticism. post to the list:
mailto:inbox@rolux.org. more information: mailto:minordomo@rolux.org, no subject
line, message body: info rolux. further questions: mailto:rolux-owner@rolux.org.
<rolux> home: http://rolux.org/lists - <rolux> archive: http://rolux.org/archive