lwall@netlabs.com (Larry Wall) (04/18/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 18, Issue 48
Archive-name: perl/part30
[There are 36 kits for perl version 4.0.]
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 36 through sh. When all 36 kits have been run, read README.
echo "This is perl 4.0 kit 30 (of 36). If kit 30 is complete, the line"
echo '"'"End of kit 30 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/scan lib msdos os2 t t/op x2p 2>/dev/null
echo Extracting os2/os2.c
sed >os2/os2.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $
X *
X * (C) Copyright 1989, 1990 Diomidis Spinellis.
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: os2.c,v $
X * Revision 4.0 91/03/20 01:36:21 lwall
X * 4.0 baseline.
X *
X * Revision 3.0.1.2 90/11/10 01:42:38 lwall
X * patch38: more msdos/os2 upgrades
X *
X * Revision 3.0.1.1 90/10/15 17:49:55 lwall
X * patch29: Initial revision
X *
X * Revision 3.0.1.1 90/03/27 16:10:41 lwall
X * patch16: MSDOS support
X *
X * Revision 1.1 90/03/18 20:32:01 dds
X * Initial revision
X *
X */
X
X#define INCL_DOS
X#define INCL_NOPM
X#include <os2.h>
X
X/*
X * Various Unix compatibility functions for OS/2
X */
X
X#include <stdio.h>
X#include <errno.h>
X#include <process.h>
X
X#include "EXTERN.h"
X#include "perl.h"
X
X
X/* dummies */
X
Xint ioctl(int handle, unsigned int function, char *data)
X{ return -1; }
X
Xint userinit()
X{ return -1; }
X
Xint syscall()
X{ return -1; }
X
X
X/* extendd chdir() */
X
Xint chdir(char *path)
X{
X if ( path[0] != 0 && path[1] == ':' )
X DosSelectDisk(toupper(path[0]) - '@');
X
X DosChDir(path, 0L);
X}
X
X
X/* priorities */
X
Xint setpriority(int class, int pid, int val)
X{
X int flag = 0;
X
X if ( pid < 0 )
X {
X flag++;
X pid = -pid;
X }
X
X return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid);
X}
X
Xint getpriority(int which /* ignored */, int pid)
X{
X USHORT val;
X
X if ( DosGetPrty(PRTYS_PROCESS, &val, pid) )
X return -1;
X else
X return val;
X}
X
X
X/* get parent process id */
X
Xint getppid(void)
X{
X PIDINFO pi;
X
X DosGetPID(&pi);
X return pi.pidParent;
X}
X
X
X/* kill */
X
Xint kill(int pid, int sig)
X{
X int flag = 0;
X
X if ( pid < 0 )
X {
X flag++;
X pid = -pid;
X }
X
X switch ( sig & 3 )
X {
X
X case 0:
X DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid);
X break;
X
X case 1: /* FLAG A */
X DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0);
X break;
X
X case 2: /* FLAG B */
X DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0);
X break;
X
X case 3: /* FLAG C */
X DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0);
X break;
X
X }
X}
X
X
X/* Sleep function. */
Xvoid
Xsleep(unsigned len)
X{
X DosSleep(len * 1000L);
X}
X
X/* Just pretend that everyone is a superuser */
X
Xint setuid()
X{ return 0; }
X
Xint setgid()
X{ return 0; }
X
Xint getuid(void)
X{ return 0; }
X
Xint geteuid(void)
X{ return 0; }
X
Xint getgid(void)
X{ return 0; }
X
Xint getegid(void)
X{ return 0; }
X
X/*
X * The following code is based on the do_exec and do_aexec functions
X * in file doio.c
X */
Xint
Xdo_aspawn(really,arglast)
XSTR *really;
Xint *arglast;
X{
X register STR **st = stack->ary_array;
X register int sp = arglast[1];
X register int items = arglast[2] - sp;
X register char **a;
X char **argv;
X char *tmps;
X int status;
X
X if (items) {
X New(1101,argv, items+1, char*);
X a = argv;
X for (st += ++sp; items > 0; items--,st++) {
X if (*st)
X *a++ = str_get(*st);
X else
X *a++ = "";
X }
X *a = Nullch;
X if (really && *(tmps = str_get(really)))
X status = spawnvp(P_WAIT,tmps,argv);
X else
X status = spawnvp(P_WAIT,argv[0],argv);
X Safefree(argv);
X }
X return status;
X}
X
Xchar *getenv(char *name);
X
Xint
Xdo_spawn(cmd)
Xchar *cmd;
X{
X register char **a;
X register char *s;
X char **argv;
X char flags[10];
X int status;
X char *shell, *cmd2;
X
X /* save an extra exec if possible */
X if ((shell = getenv("COMSPEC")) == 0)
X shell = "C:\\OS2\\CMD.EXE";
X
X /* see if there are shell metacharacters in it */
X if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|')
X || strchr(cmd, '&') || strchr(cmd, '^'))
X doshell:
X return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0);
X
X New(1102,argv, strlen(cmd) / 2 + 2, char*);
X
X New(1103,cmd2, strlen(cmd) + 1, char);
X strcpy(cmd2, cmd);
X a = argv;
X for (s = cmd2; *s;) {
X while (*s && isspace(*s)) s++;
X if (*s)
X *(a++) = s;
X while (*s && !isspace(*s)) s++;
X if (*s)
X *s++ = '\0';
X }
X *a = Nullch;
X if (argv[0])
X if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
X Safefree(argv);
X Safefree(cmd2);
X goto doshell;
X }
X Safefree(cmd2);
X Safefree(argv);
X return status;
X}
X
Xusage(char *myname)
X{
X#ifdef MSDOS
X printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
X#else
X printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
X#endif
X "\n [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname);
X
X printf("\n -a autosplit mode with -n or -p"
X "\n -c syntaxcheck only"
X "\n -d run scripts under debugger"
X "\n -n assume 'while (<>) { ...script... }' loop arround your script"
X "\n -p assume loop like -n but print line also like sed"
X#ifndef MSDOS
X "\n -P run script through C preprocessor befor compilation"
X#endif
X "\n -s enable some switch parsing for switches after script name"
X "\n -S look for the script using PATH environment variable");
X#ifndef MSDOS
X printf("\n -u dump core after compiling the script"
X "\n -U allow unsafe operations");
X#endif
X printf("\n -v print version number and patchlevel of perl"
X "\n -w turn warnings on for compilation of your script\n"
X "\n -0[octal] specify record separator (0, if no argument)"
X "\n -Dnumber set debugging flags (argument is a bit mask)"
X "\n -i[extension] edit <> files in place (make backup if extension supplied)"
X "\n -Idirectory specify include directory in conjunction with -P"
X "\n -e command one line of script, multiple -e options are allowed"
X "\n [filename] can be ommitted, when -e is used"
X "\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n");
X}
!STUFFY!FUNK!
echo Extracting lib/syslog.pl
sed >lib/syslog.pl <<'!STUFFY!FUNK!' -e 's/X//'
X#
X# syslog.pl
X#
X# $Log: syslog.pl,v $
X# Revision 4.0 91/03/20 01:26:24 lwall
X# 4.0 baseline.
X#
X# Revision 3.0.1.4 90/11/10 01:41:11 lwall
X# patch38: syslog.pl was referencing an absolute path
X#
X# Revision 3.0.1.3 90/10/15 17:42:18 lwall
X# patch29: various portability fixes
X#
X# Revision 3.0.1.1 90/08/09 03:57:17 lwall
X# patch19: Initial revision
X#
X# Revision 1.2 90/06/11 18:45:30 18:45:30 root ()
X# - Changed 'warn' to 'mail|warning' in test call (to give example of
X# facility specification, and because 'warn' didn't work on HP-UX).
X# - Fixed typo in &openlog ("ncons" should be "cons").
X# - Added (package-global) $maskpri, and &setlogmask.
X# - In &syslog:
X# - put argument test ahead of &connect (why waste cycles?),
X# - allowed facility to be specified in &syslog's first arg (temporarily
X# overrides any $facility set in &openlog), just as in syslog(3C),
X# - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)),
X# - changed $whoami code to use getlogin, getpwuid($<) and 'syslog'
X# (in that order) when $ident is null,
X# - made PID logging consistent with syslog(3C) and subject to $lo_pid only,
X# - fixed typo in "print CONS" statement ($<facility should be <$facility).
X# - changed \n to \r in print CONS (\r is useful, $message already has a \n).
X# - Changed &xlate to return -1 for an unknown name, instead of croaking.
X#
X#
X# tom christiansen <tchrist@convex.com>
X# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
X# NOTE: openlog now takes three arguments, just like openlog(3)
X#
X# call syslog() with a string priority and a list of printf() args
X# like syslog(3)
X#
X# usage: require 'syslog.pl';
X#
X# then (put these all in a script to test function)
X#
X#
X# do openlog($program,'cons,pid','user');
X# do syslog('info','this is another test');
X# do syslog('mail|warning','this is a better test: %d', time);
X# do closelog();
X#
X# do syslog('debug','this is the last test');
X# do openlog("$program $$",'ndelay','user');
X# do syslog('notice','fooprogram: this is really done');
X#
X# $! = 55;
X# do syslog('info','problem was %m'); # %m == $! in syslog(3)
X
Xpackage syslog;
X
X$host = 'localhost' unless $host; # set $syslog'host to change
X
Xrequire 'syslog.ph';
X
X$maskpri = &LOG_UPTO(&LOG_DEBUG);
X
Xsub main'openlog {
X ($ident, $logopt, $facility) = @_; # package vars
X $lo_pid = $logopt =~ /\bpid\b/;
X $lo_ndelay = $logopt =~ /\bndelay\b/;
X $lo_cons = $logopt =~ /\bcons\b/;
X $lo_nowait = $logopt =~ /\bnowait\b/;
X &connect if $lo_ndelay;
X}
X
Xsub main'closelog {
X $facility = $ident = '';
X &disconnect;
X}
X
Xsub main'setlogmask {
X local($oldmask) = $maskpri;
X $maskpri = shift;
X $oldmask;
X}
X
Xsub main'syslog {
X local($priority) = shift;
X local($mask) = shift;
X local($message, $whoami);
X local(@words, $num, $numpri, $numfac, $sum);
X local($facility) = $facility; # may need to change temporarily.
X
X die "syslog: expected both priority and mask" unless $mask && $priority;
X
X @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
X undef $numpri;
X undef $numfac;
X foreach (@words) {
X $num = &xlate($_); # Translate word to number.
X if (/^kern$/ || $num < 0) {
X die "syslog: invalid level/facility: $_\n";
X }
X elsif ($num <= &LOG_PRIMASK) {
X die "syslog: too many levels given: $_\n" if defined($numpri);
X $numpri = $num;
X return 0 unless &LOG_MASK($numpri) & $maskpri;
X }
X else {
X die "syslog: too many facilities given: $_\n" if defined($numfac);
X $facility = $_;
X $numfac = $num;
X }
X }
X
X die "syslog: level must be given\n" unless defined($numpri);
X
X if (!defined($numfac)) { # Facility not specified in this call.
X $facility = 'user' unless $facility;
X $numfac = &xlate($facility);
X }
X
X &connect unless $connected;
X
X $whoami = $ident;
X
X if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
X $whoami = $1;
X $mask = $2;
X }
X
X unless ($whoami) {
X ($whoami = getlogin) ||
X ($whoami = getpwuid($<)) ||
X ($whoami = 'syslog');
X }
X
X $whoami .= "[$$]" if $lo_pid;
X
X $mask =~ s/%m/$!/g;
X $mask .= "\n" unless $mask =~ /\n$/;
X $message = sprintf ($mask, @_);
X
X $sum = $numpri + $numfac;
X unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
X if ($lo_cons) {
X if ($pid = fork) {
X unless ($lo_nowait) {
X do {$died = wait;} until $died == $pid || $died < 0;
X }
X }
X else {
X open(CONS,">/dev/console");
X print CONS "<$facility.$priority>$whoami: $message\r";
X exit if defined $pid; # if fork failed, we're parent
X close CONS;
X }
X }
X }
X}
X
Xsub xlate {
X local($name) = @_;
X $name =~ y/a-z/A-Z/;
X $name = "LOG_$name" unless $name =~ /^LOG_/;
X $name = "syslog'$name";
X eval &$name || -1;
X}
X
Xsub connect {
X $pat = 'S n C4 x8';
X
X $af_unix = 1;
X $af_inet = 2;
X
X $stream = 1;
X $datagram = 2;
X
X ($name,$aliases,$proto) = getprotobyname('udp');
X $udp = $proto;
X
X ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
X $syslog = $port;
X
X if (chop($myname = `hostname`)) {
X ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
X die "Can't lookup $myname\n" unless $name;
X @bytes = unpack("C4",$addrs[0]);
X }
X else {
X @bytes = (0,0,0,0);
X }
X $this = pack($pat, $af_inet, 0, @bytes);
X
X if ($host =~ /^\d+\./) {
X @bytes = split(/\./,$host);
X }
X else {
X ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
X die "Can't lookup $host\n" unless $name;
X @bytes = unpack("C4",$addrs[0]);
X }
X $that = pack($pat,$af_inet,$syslog,@bytes);
X
X socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
X bind(SYSLOG,$this) || die "bind: $!\n";
X connect(SYSLOG,$that) || die "connect: $!\n";
X
X local($old) = select(SYSLOG); $| = 1; select($old);
X $connected = 1;
X}
X
Xsub disconnect {
X close SYSLOG;
X $connected = 0;
X}
X
X1;
!STUFFY!FUNK!
echo Extracting array.c
sed >array.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: array.c,v 4.0 91/03/20 01:03:32 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: array.c,v $
X * Revision 4.0 91/03/20 01:03:32 lwall
X * 4.0 baseline.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
XSTR *
Xafetch(ar,key,lval)
Xregister ARRAY *ar;
Xint key;
Xint lval;
X{
X STR *str;
X
X if (key < 0 || key > ar->ary_fill) {
X if (lval && key >= 0) {
X if (ar->ary_flags & ARF_REAL)
X str = Str_new(5,0);
X else
X str = str_mortal(&str_undef);
X (void)astore(ar,key,str);
X return str;
X }
X else
X return &str_undef;
X }
X if (!ar->ary_array[key]) {
X if (lval) {
X str = Str_new(6,0);
X (void)astore(ar,key,str);
X return str;
X }
X return &str_undef;
X }
X return ar->ary_array[key];
X}
X
Xbool
Xastore(ar,key,val)
Xregister ARRAY *ar;
Xint key;
XSTR *val;
X{
X int retval;
X
X if (key < 0)
X return FALSE;
X if (key > ar->ary_max) {
X int newmax;
X
X if (ar->ary_alloc != ar->ary_array) {
X retval = ar->ary_array - ar->ary_alloc;
X Copy(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*);
X Zero(ar->ary_alloc+ar->ary_max+1, retval, STR*);
X ar->ary_max += retval;
X ar->ary_array -= retval;
X if (key > ar->ary_max - 10) {
X newmax = key + ar->ary_max;
X goto resize;
X }
X }
X else {
X if (ar->ary_alloc) {
X newmax = key + ar->ary_max / 5;
X resize:
X Renew(ar->ary_alloc,newmax+1, STR*);
X Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*);
X }
X else {
X newmax = key < 4 ? 4 : key;
X Newz(2,ar->ary_alloc, newmax+1, STR*);
X }
X ar->ary_array = ar->ary_alloc;
X ar->ary_max = newmax;
X }
X }
X if ((ar->ary_flags & ARF_REAL) && ar->ary_fill < key) {
X while (++ar->ary_fill < key) {
X if (ar->ary_array[ar->ary_fill] != Nullstr) {
X str_free(ar->ary_array[ar->ary_fill]);
X ar->ary_array[ar->ary_fill] = Nullstr;
X }
X }
X }
X retval = (ar->ary_array[key] != Nullstr);
X if (retval && (ar->ary_flags & ARF_REAL))
X str_free(ar->ary_array[key]);
X ar->ary_array[key] = val;
X return retval;
X}
X
XARRAY *
Xanew(stab)
XSTAB *stab;
X{
X register ARRAY *ar;
X
X New(1,ar,1,ARRAY);
X ar->ary_magic = Str_new(7,0);
X ar->ary_alloc = ar->ary_array = 0;
X str_magic(ar->ary_magic, stab, '#', Nullch, 0);
X ar->ary_max = ar->ary_fill = -1;
X ar->ary_flags = ARF_REAL;
X return ar;
X}
X
XARRAY *
Xafake(stab,size,strp)
XSTAB *stab;
Xregister int size;
Xregister STR **strp;
X{
X register ARRAY *ar;
X
X New(3,ar,1,ARRAY);
X New(4,ar->ary_alloc,size+1,STR*);
X Copy(strp,ar->ary_alloc,size,STR*);
X ar->ary_array = ar->ary_alloc;
X ar->ary_magic = Str_new(8,0);
X str_magic(ar->ary_magic, stab, '#', Nullch, 0);
X ar->ary_fill = size - 1;
X ar->ary_max = size - 1;
X ar->ary_flags = 0;
X while (size--) {
X (*strp++)->str_pok &= ~SP_TEMP;
X }
X return ar;
X}
X
Xvoid
Xaclear(ar)
Xregister ARRAY *ar;
X{
X register int key;
X
X if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0)
X return;
X if (key = ar->ary_array - ar->ary_alloc) {
X ar->ary_max += key;
X ar->ary_array -= key;
X }
X for (key = 0; key <= ar->ary_max; key++)
X str_free(ar->ary_array[key]);
X ar->ary_fill = -1;
X Zero(ar->ary_array, ar->ary_max+1, STR*);
X}
X
Xvoid
Xafree(ar)
Xregister ARRAY *ar;
X{
X register int key;
X
X if (!ar)
X return;
X if (key = ar->ary_array - ar->ary_alloc) {
X ar->ary_max += key;
X ar->ary_array -= key;
X }
X if (ar->ary_flags & ARF_REAL) {
X for (key = 0; key <= ar->ary_max; key++)
X str_free(ar->ary_array[key]);
X }
X str_free(ar->ary_magic);
X Safefree(ar->ary_alloc);
X Safefree(ar);
X}
X
Xbool
Xapush(ar,val)
Xregister ARRAY *ar;
XSTR *val;
X{
X return astore(ar,++(ar->ary_fill),val);
X}
X
XSTR *
Xapop(ar)
Xregister ARRAY *ar;
X{
X STR *retval;
X
X if (ar->ary_fill < 0)
X return Nullstr;
X retval = ar->ary_array[ar->ary_fill];
X ar->ary_array[ar->ary_fill--] = Nullstr;
X return retval;
X}
X
Xaunshift(ar,num)
Xregister ARRAY *ar;
Xregister int num;
X{
X register int i;
X register STR **sstr,**dstr;
X
X if (num <= 0)
X return;
X if (ar->ary_array - ar->ary_alloc >= num) {
X ar->ary_max += num;
X ar->ary_fill += num;
X while (num--)
X *--ar->ary_array = Nullstr;
X }
X else {
X (void)astore(ar,ar->ary_fill+num,(STR*)0); /* maybe extend array */
X dstr = ar->ary_array + ar->ary_fill;
X sstr = dstr - num;
X#ifdef BUGGY_MSC5
X # pragma loop_opt(off) /* don't loop-optimize the following code */
X#endif /* BUGGY_MSC5 */
X for (i = ar->ary_fill; i >= 0; i--) {
X *dstr-- = *sstr--;
X#ifdef BUGGY_MSC5
X # pragma loop_opt() /* loop-optimization back to command-line setting */
X#endif /* BUGGY_MSC5 */
X }
X Zero(ar->ary_array, num, STR*);
X }
X}
X
XSTR *
Xashift(ar)
Xregister ARRAY *ar;
X{
X STR *retval;
X
X if (ar->ary_fill < 0)
X return Nullstr;
X retval = *ar->ary_array;
X *(ar->ary_array++) = Nullstr;
X ar->ary_max--;
X ar->ary_fill--;
X return retval;
X}
X
Xint
Xalen(ar)
Xregister ARRAY *ar;
X{
X return ar->ary_fill;
X}
X
Xafill(ar, fill)
Xregister ARRAY *ar;
Xint fill;
X{
X if (fill < 0)
X fill = -1;
X if (fill <= ar->ary_max)
X ar->ary_fill = fill;
X else
X (void)astore(ar,fill,Nullstr);
X}
!STUFFY!FUNK!
echo Extracting t/op/stat.t
sed >t/op/stat.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $
X
Xprint "1..56\n";
X
Xchop($cwd = `pwd`);
X
Xunlink "Op.stat.tmp";
Xopen(foo, ">Op.stat.tmp");
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat(foo);
Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
X
Xprint foo "Now is the time for all good men to come to.\n";
Xclose(foo);
X
Xsleep 2;
X
X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('Op.stat.tmp');
X
Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
Xif (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) {
X print "ok 4\n";
X}
Xelse {
X print "not ok 4\n";
X}
Xprint "#4 :$mtime: != :$ctime:\n";
X
X`cp /dev/null Op.stat.tmp`;
X
Xif (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
Xif (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
X
X`echo hi >Op.stat.tmp`;
Xif (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
Xif (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
X
Xunlink 'Op.stat.tmp';
X$olduid = $>; # can't test -r if uid == 0
X`echo hi >Op.stat.tmp`;
Xchmod 0,'Op.stat.tmp';
Xeval '$> = 1;'; # so switch uid (may not be implemented)
Xif (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
Xif (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
Xeval '$> = $olduid;'; # switch uid back (may not be implemented)
Xprint "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
Xif (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";}
X
Xforeach ((12,13,14,15,16,17)) {
X print "ok $_\n"; #deleted tests
X}
X
Xchmod 0700,'Op.stat.tmp';
Xif (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
Xif (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
Xif (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
X
Xif (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
Xif (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
X
Xif (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
Xif (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
X
Xif (`ls -l perl` =~ /^l.*->/) {
X if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
X}
Xelse {
X print "ok 25\n";
X}
X
Xif (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
X
Xif (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
X`rm -f Op.stat.tmp Op.stat.tmp2`;
Xif (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
X
Xif (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
Xif (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
X
Xif (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
X {print "ok 31\n";}
Xelse
X {print "not ok 31\n";}
Xif (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
X
Xif (! -e '/dev/mt0' || -b '/dev/mt0')
X {print "ok 33\n";}
Xelse
X {print "not ok 33\n";}
Xif (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
X
X$cnt = $uid = 0;
X
Xdie "Can't run op/stat.t test 35 without pwd working" unless $cwd;
Xchdir '/usr/bin' || die "Can't cd to /usr/bin";
Xwhile (defined($_ = <*>)) {
X $cnt++;
X $uid++ if -u;
X last if $uid && $uid < $cnt;
X}
Xchdir $cwd || die "Can't cd back to $cwd";
X
X# I suppose this is going to fail somewhere...
Xif ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
X
Xunless (open(tty,"/dev/tty")) {
X print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
X}
Xif (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
Xif (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
Xclose(tty);
Xif (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
Xopen(null,"/dev/null");
Xif (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";}
Xclose(null);
Xif (-t) {print "ok 40\n";} else {print "not ok 40\n";}
X
X# These aren't strictly "stat" calls, but so what?
X
Xif (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
Xif (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
X
Xif (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
Xif (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
X
Xopen(foo,'op/stat.t');
Xif (-T foo) {print "ok 45\n";} else {print "not ok 45\n";}
Xif (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";}
X$_ = <foo>;
Xif (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
Xif (-T foo) {print "ok 48\n";} else {print "not ok 48\n";}
Xif (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";}
Xclose(foo);
X
Xopen(foo,'op/stat.t');
X$_ = <foo>;
Xif (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
Xif (-T foo) {print "ok 51\n";} else {print "not ok 51\n";}
Xif (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";}
Xseek(foo,0,0);
Xif (-T foo) {print "ok 53\n";} else {print "not ok 53\n";}
Xif (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";}
Xclose(foo);
X
Xif (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
Xif (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
!STUFFY!FUNK!
echo Extracting msdos/msdos.c
sed >msdos/msdos.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: msdos.c,v 4.0 91/03/20 01:34:46 lwall Locked $
X *
X * (C) Copyright 1989, 1990 Diomidis Spinellis.
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: msdos.c,v $
X * Revision 4.0 91/03/20 01:34:46 lwall
X * 4.0 baseline.
X *
X * Revision 3.0.1.1 90/03/27 16:10:41 lwall
X * patch16: MSDOS support
X *
X * Revision 1.1 90/03/18 20:32:01 dds
X * Initial revision
X *
X */
X
X/*
X * Various Unix compatibility functions for MS-DOS.
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <dos.h>
X#include <process.h>
X
X/*
X * Interface to the MS-DOS ioctl system call.
X * The function is encoded as follows:
X * The lowest nibble of the function code goes to AL
X * The two middle nibbles go to CL
X * The high nibble goes to CH
X *
X * The return code is -1 in the case of an error and if successful
X * for functions AL = 00, 09, 0a the value of the register DX
X * for functions AL = 02 - 08, 0e the value of the register AX
X * for functions AL = 01, 0b - 0f the number 0
X *
X * Notice that this restricts the ioctl subcodes stored in AL to 00-0f
X * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f
X * so we are ok.
X * Furthermore CH is also restriced in the same area. Where CH is used as a
X * code it always is between 00-0f. In the case where it forms a count
X * together with CL we arbitrarily set the highest count limit to 4095. It
X * sounds reasonable for an ioctl.
X * The other alternative would have been to use the pointer argument to
X * point the the values of CX. The problem with this approach is that
X * of accessing wild regions when DX is used as a number and not as a
X * pointer.
X */
Xint
Xioctl(int handle, unsigned int function, char *data)
X{
X union REGS srv;
X struct SREGS segregs;
X
X srv.h.ah = 0x44;
X srv.h.al = (unsigned char)(function & 0x0F);
X srv.x.bx = handle;
X srv.x.cx = function >> 4;
X segread(&segregs);
X#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
X segregs.ds = FP_SEG(data);
X srv.x.dx = FP_OFF(data);
X#else
X srv.x.dx = (unsigned int) data;
X#endif
X intdosx(&srv, &srv, &segregs);
X if (srv.x.cflag & 1) {
X switch(srv.x.ax ){
X case 1:
X errno = EINVAL;
X break;
X case 2:
X case 3:
X errno = ENOENT;
X break;
X case 4:
X errno = EMFILE;
X break;
X case 5:
X errno = EPERM;
X break;
X case 6:
X errno = EBADF;
X break;
X case 8:
X errno = ENOMEM;
X break;
X case 0xc:
X case 0xd:
X case 0xf:
X errno = EINVAL;
X break;
X case 0x11:
X errno = EXDEV;
X break;
X case 0x12:
X errno = ENFILE;
X break;
X default:
X errno = EZERO;
X break;
X }
X return -1;
X } else {
X switch (function & 0xf) {
X case 0: case 9: case 0xa:
X return srv.x.dx;
X case 2: case 3: case 4: case 5:
X case 6: case 7: case 8: case 0xe:
X return srv.x.ax;
X case 1: case 0xb: case 0xc: case 0xd:
X case 0xf:
X default:
X return 0;
X }
X }
X}
X
X
X/*
X * Sleep function.
X */
Xvoid
Xsleep(unsigned len)
X{
X time_t end;
X
X end = time((time_t *)0) + len;
X while (time((time_t *)0) < end)
X ;
X}
X
X/*
X * Just pretend that everyone is a superuser
X */
X#define ROOT_UID 0
X#define ROOT_GID 0
Xint
Xgetuid(void)
X{
X return ROOT_UID;
X}
X
Xint
Xgeteuid(void)
X{
X return ROOT_UID;
X}
X
Xint
Xgetgid(void)
X{
X return ROOT_GID;
X}
X
Xint
Xgetegid(void)
X{
X return ROOT_GID;
X}
X
Xint
Xsetuid(int uid)
X{ return (uid==ROOT_UID?0:-1); }
X
Xint
Xsetgid(int gid)
X{ return (gid==ROOT_GID?0:-1); }
X
X/*
X * The following code is based on the do_exec and do_aexec functions
X * in file doio.c
X */
Xint
Xdo_aspawn(really,arglast)
XSTR *really;
Xint *arglast;
X{
X register STR **st = stack->ary_array;
X register int sp = arglast[1];
X register int items = arglast[2] - sp;
X register char **a;
X char **argv;
X char *tmps;
X int status;
X
X if (items) {
X New(1101,argv, items+1, char*);
X a = argv;
X for (st += ++sp; items > 0; items--,st++) {
X if (*st)
X *a++ = str_get(*st);
X else
X *a++ = "";
X }
X *a = Nullch;
X if (really && *(tmps = str_get(really)))
X status = spawnvp(P_WAIT,tmps,argv);
X else
X status = spawnvp(P_WAIT,argv[0],argv);
X Safefree(argv);
X }
X return status;
X}
X
X
Xint
Xdo_spawn(cmd)
Xchar *cmd;
X{
X register char **a;
X register char *s;
X char **argv;
X char flags[10];
X int status;
X char *shell, *cmd2;
X
X /* save an extra exec if possible */
X if ((shell = getenv("COMSPEC")) == 0)
X shell = "\\command.com";
X
X /* see if there are shell metacharacters in it */
X if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|'))
X doshell:
X return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0);
X
X New(1102,argv, strlen(cmd) / 2 + 2, char*);
X
X New(1103,cmd2, strlen(cmd) + 1, char);
X strcpy(cmd2, cmd);
X a = argv;
X for (s = cmd2; *s;) {
X while (*s && isspace(*s)) s++;
X if (*s)
X *(a++) = s;
X while (*s && !isspace(*s)) s++;
X if (*s)
X *s++ = '\0';
X }
X *a = Nullch;
X if (argv[0])
X if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
X Safefree(argv);
X Safefree(cmd2);
X goto doshell;
X }
X Safefree(cmd2);
X Safefree(argv);
X return status;
X}
!STUFFY!FUNK!
echo Extracting eg/scan/scan_messages
sed >eg/scan/scan_messages <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_messages,v 4.0 91/03/20 01:13:01 lwall Locked $
X
X# This prints out extraordinary console messages. You'll need to customize.
X
Xchdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
X
X$maxpos = `cat oldmsgs 2>&1`;
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
Xopen(Msgs, '/dev/null') || die "scan_messages: can't open messages";
X#else
Xopen(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages";
X#endif
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat(Msgs);
X
Xif ($size < $maxpos) { # Did somebody truncate messages file?
X $maxpos = 0;
X}
X
Xseek(Msgs,$maxpos,0); # Start where we left off last time.
X
Xwhile (<Msgs>) {
X s/\[(\d+)\]/#/ && s/$1/#/g;
X#ifdef vax
X $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//;
X next if /root@.*:/;
X next if /^vmunix: 4.3 BSD UNIX/;
X next if /^vmunix: Copyright/;
X next if /^vmunix: avail mem =/;
X next if /^vmunix: SBIA0 at /;
X next if /^vmunix: disk ra81 is/;
X next if /^vmunix: dmf. at uba/;
X next if /^vmunix: dmf.:.*asynch/;
X next if /^vmunix: ex. at uba/;
X next if /^vmunix: ex.: HW/;
X next if /^vmunix: il. at uba/;
X next if /^vmunix: il.: hardware/;
X next if /^vmunix: ra. at uba/;
X next if /^vmunix: ra.: media/;
X next if /^vmunix: real mem/;
X next if /^vmunix: syncing disks/;
X next if /^vmunix: tms/;
X next if /^vmunix: tmscp. at uba/;
X next if /^vmunix: uba. at /;
X next if /^vmunix: uda. at /;
X next if /^vmunix: uda.: unit . ONLIN/;
X next if /^vmunix: .*buffers containing/;
X next if /^syslogd: .*newslog/;
X#endif
X next if /unknown service/;
X next if /^\.\.\.$/;
X if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) {
X $pfx = '';
X next;
X }
X next if /^[ \t]*$/;
X next if /^[ 0-9]*done$/;
X if (/^A/) {
X next if /^Accounting [sr]/;
X }
X elsif (/^C/) {
X next if /^Called from/;
X next if /^Copyright/;
X }
X elsif (/^E/) {
X next if /^End traceback/;
X next if /^Ethernet address =/;
X }
X elsif (/^K/) {
X next if /^KERNEL MODE/;
X }
X elsif (/^R/) {
X next if /^Rebooting Unix/;
X }
X elsif (/^S/) {
X next if /^Sun UNIX 4\.2 Release/;
X }
X elsif (/^W/) {
X next if /^WARNING: clock gained/;
X }
X elsif (/^a/) {
X next if /^arg /;
X next if /^avail mem =/;
X }
X elsif (/^b/) {
X next if /^bwtwo[0-9] at /;
X }
X elsif (/^c/) {
X next if /^cgone[0-9] at /;
X next if /^cdp[0-9] at /;
X next if /^csr /;
X }
X elsif (/^d/) {
X next if /^dcpa: init/;
X next if /^done$/;
X next if /^dts/;
X next if /^dump i\/o error/;
X next if /^dumping to dev/;
X next if /^dump succeeded/;
X $pfx = '*' if /^dev = /;
X }
X elsif (/^e/) {
X next if /^end \*\*/;
X next if /^error in copy/;
X }
X elsif (/^f/) {
X next if /^found /;
X }
X elsif (/^i/) {
X next if /^ib[0-9] at /;
X next if /^ie[0-9] at /;
X }
X elsif (/^l/) {
X next if /^le[0-9] at /;
X }
X elsif (/^m/) {
X next if /^mem = /;
X next if /^mt[0-9] at /;
X next if /^mti[0-9] at /;
X $pfx = '*' if /^mode = /;
X }
X elsif (/^n/) {
X next if /^not found /;
X }
X elsif (/^p/) {
X next if /^page map /;
X next if /^pi[0-9] at /;
X $pfx = '*' if /^panic/;
X }
X elsif (/^q/) {
X next if /^qqq /;
X }
X elsif (/^r/) {
X next if /^read /;
X next if /^revarp: Requesting/;
X next if /^root [od]/;
X }
X elsif (/^s/) {
X next if /^sc[0-9] at /;
X next if /^sd[0-9] at /;
X next if /^sd[0-9]: </;
X next if /^si[0-9] at /;
X next if /^si_getstatus/;
X next if /^sk[0-9] at /;
X next if /^skioctl/;
X next if /^skopen/;
X next if /^skprobe/;
X next if /^skread/;
X next if /^skwrite/;
X next if /^sky[0-9] at /;
X next if /^st[0-9] at /;
X next if /^st0:.*load/;
X next if /^stat1 = /;
X next if /^syncing disks/;
X next if /^syslogd: going down on signal 15/;
X }
X elsif (/^t/) {
X next if /^timeout [0-9]/;
X next if /^tm[0-9] at /;
X next if /^tod[0-9] at /;
X next if /^tv [0-9]/;
X $pfx = '*' if /^trap address/;
X }
X elsif (/^u/) {
X next if /^unit nsk/;
X next if /^use one of/;
X $pfx = '' if /^using/;
X next if /^using [0-9]+ buffers/;
X }
X elsif (/^x/) {
X next if /^xy[0-9] at /;
X next if /^write [0-9]/;
X next if /^xy[0-9]: </;
X next if /^xyc[0-9] at /;
X }
X elsif (/^y/) {
X next if /^yyy [0-9]/;
X }
X elsif (/^z/) {
X next if /^zs[0-9] at /;
X }
X $pfx = '*' if /^[a-z]+:$/;
X s/pid [0-9]+: //;
X if (/last message repeated ([0-9]+) time/) {
X $seen{$last} += $1;
X next;
X }
X s/^/$pfx/ if $pfx;
X unless ($seen{$_}++) {
X push(@seen,$_);
X }
X $last = $_;
X}
X$max = tell(Msgs);
X
Xopen(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file: $!\n";
Xwhile ($_ = pop(@seen)) {
X print tmp $_;
X}
Xclose(tmp);
Xopen(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n";
Xwhile (<tmp>) {
X if (/^nd:/) {
X next if $seen{$_} < 20;
X }
X if (/NFS/) {
X next if $seen{$_} < 20;
X }
X if (/no carrier/) {
X next if $seen{$_} < 20;
X }
X if (/silo overflow/) {
X next if $seen{$_} < 20;
X }
X print $seen{$_},":\t",$_;
X}
X
Xprint `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`;
!STUFFY!FUNK!
echo Extracting x2p/util.c
sed >x2p/util.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: util.c,v $
X * Revision 4.0 91/03/20 01:58:25 lwall
X * 4.0 baseline.
X *
X */
X
X#include <stdio.h>
X
X#include "handy.h"
X#include "EXTERN.h"
X#include "a2p.h"
X#include "INTERN.h"
X#include "util.h"
X
X#define FLUSH
X#define MEM_SIZE unsigned int
X
Xstatic char nomem[] = "Out of memory!\n";
X
X/* paranoid version of malloc */
X
Xstatic int an = 0;
X
Xchar *
Xsafemalloc(size)
XMEM_SIZE size;
X{
X char *ptr;
X char *malloc();
X
X ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X}
X
X/* paranoid version of realloc */
X
Xchar *
Xsaferealloc(where,size)
Xchar *where;
XMEM_SIZE size;
X{
X char *ptr;
X char *realloc();
X
X ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X if (debug & 128) {
X fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
X fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
X }
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X}
X
X/* safe version of free */
X
Xsafefree(where)
Xchar *where;
X{
X#ifdef DEBUGGING
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
X#endif
X free(where);
X}
X
X/* safe version of string copy */
X
Xchar *
Xsafecpy(to,from,len)
Xchar *to;
Xregister char *from;
Xregister int len;
X{
X register char *dest = to;
X
X if (from != Nullch)
X for (len--; len && (*dest++ = *from++); len--) ;
X *dest = '\0';
X return to;
X}
X
X/* copy a string up to some (non-backslashed) delimiter, if any */
X
Xchar *
Xcpytill(to,from,delim)
Xregister char *to, *from;
Xregister int delim;
X{
X for (; *from; from++,to++) {
X if (*from == '\\') {
X if (from[1] == delim)
X from++;
X else if (from[1] == '\\')
X *to++ = *from++;
X }
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X return from;
X}
X
X
Xchar *
Xcpy2(to,from,delim)
Xregister char *to, *from;
Xregister int delim;
X{
X for (; *from; from++,to++) {
X if (*from == '\\')
X *to++ = *from++;
X else if (*from == '$')
X *to++ = '\\';
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X return from;
X}
X
X/* return ptr to little string in big string, NULL if not found */
X
Xchar *
Xinstr(big, little)
Xchar *big, *little;
X
X{
X register char *t, *s, *x;
X
X for (t = big; *t; t++) {
X for (x=t,s=little; *s; x++,s++) {
X if (!*x)
X return Nullch;
X if (*s != *x)
X break;
X }
X if (!*s)
X return t;
X }
X return Nullch;
X}
X
X/* copy a string to a safe spot */
X
Xchar *
Xsavestr(str)
Xchar *str;
X{
X register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
X
X (void)strcpy(newaddr,str);
X return newaddr;
X}
X
X/* grow a static string to at least a certain length */
X
Xvoid
Xgrowstr(strptr,curlen,newlen)
Xchar **strptr;
Xint *curlen;
Xint newlen;
X{
X if (newlen > *curlen) { /* need more room? */
X if (*curlen)
X *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
X else
X *strptr = safemalloc((MEM_SIZE)newlen);
X *curlen = newlen;
X }
X}
X
X/*VARARGS1*/
Xfatal(pat,a1,a2,a3,a4)
Xchar *pat;
X{
X fprintf(stderr,pat,a1,a2,a3,a4);
X exit(1);
X}
X
X/*VARARGS1*/
Xwarn(pat,a1,a2,a3,a4)
Xchar *pat;
X{
X fprintf(stderr,pat,a1,a2,a3,a4);
X}
X
Xstatic bool firstsetenv = TRUE;
Xextern char **environ;
X
Xvoid
Xsetenv(nam,val)
Xchar *nam, *val;
X{
X register int i=envix(nam); /* where does it go? */
X
X if (!environ[i]) { /* does not exist yet */
X if (firstsetenv) { /* need we copy environment? */
X int j;
X#ifndef lint
X char **tmpenv = (char**) /* point our wand at memory */
X safemalloc((i+2) * sizeof(char*));
X#else
X char **tmpenv = Null(char **);
X#endif /* lint */
X
X firstsetenv = FALSE;
X for (j=0; j<i; j++) /* copy environment */
X tmpenv[j] = environ[j];
X environ = tmpenv; /* tell exec where it is now */
X }
X#ifndef lint
X else
X environ = (char**) saferealloc((char*) environ,
X (i+2) * sizeof(char*));
X /* just expand it a bit */
X#endif /* lint */
X environ[i+1] = Nullch; /* make sure it's null terminated */
X }
X environ[i] = safemalloc(strlen(nam) + strlen(val) + 2);
X /* this may or may not be in */
X /* the old environ structure */
X sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
X}
X
Xint
Xenvix(nam)
Xchar *nam;
X{
X register int i, len = strlen(nam);
X
X for (i = 0; environ[i]; i++) {
X if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
X break; /* strnEQ must come first to avoid */
X } /* potential SEGV's */
X return i;
X}
!STUFFY!FUNK!
echo Extracting os2/director.c
sed >os2/director.c <<'!STUFFY!FUNK!' -e 's/X//'
X/*
X * @(#)dir.c 1.4 87/11/06 Public Domain.
X *
X * A public domain implementation of BSD directory routines for
X * MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield),
X * August 1897
X * Ported to OS/2 by Kai Uwe Rommel
X * December 1989, February 1990
X * Change for HPFS support, October 1990
X */
X
X#include <sys/types.h>
X#include <sys/stat.h>
X#include <sys/dir.h>
X
X#include <stdlib.h>
X#include <stdio.h>
X#include <malloc.h>
X#include <string.h>
X#include <ctype.h>
X
X#define INCL_NOPM
X#include <os2.h>
X
X
X#ifndef PERLGLOB
Xint attributes = A_DIR | A_HIDDEN;
X
X
Xstatic char *getdirent(char *);
Xstatic void free_dircontents(struct _dircontents *);
X
Xstatic HDIR hdir;
Xstatic USHORT count;
Xstatic FILEFINDBUF find;
Xstatic BOOL lower;
X
X
XDIR *opendir(char *name)
X{
X struct stat statb;
X DIR *dirp;
X char c;
X char *s;
X struct _dircontents *dp;
X char nbuf[MAXPATHLEN + 1];
X
X strcpy(nbuf, name);
X
X if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
X (strlen(nbuf) > 1) )
X {
X nbuf[strlen(nbuf) - 1] = 0;
X
X if ( nbuf[strlen(nbuf) - 1] == ':' )
X strcat(nbuf, "\\.");
X }
X else
X if ( nbuf[strlen(nbuf) - 1] == ':' )
X strcat(nbuf, ".");
X
X if (stat(nbuf, &statb) < 0 || (statb.st_mode & S_IFMT) != S_IFDIR)
X return NULL;
X
X if ( (dirp = malloc(sizeof(DIR))) == NULL )
X return NULL;
X
X if ( nbuf[strlen(nbuf) - 1] == '.' )
X strcpy(nbuf + strlen(nbuf) - 1, "*.*");
X else
X if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
X (strlen(nbuf) == 1) )
X strcat(nbuf, "*.*");
X else
X strcat(nbuf, "\\*.*");
X
X dirp -> dd_loc = 0;
X dirp -> dd_contents = dirp -> dd_cp = NULL;
X
X if ((s = getdirent(nbuf)) == NULL)
X return dirp;
X
X do
X {
X if (((dp = malloc(sizeof(struct _dircontents))) == NULL) ||
X ((dp -> _d_entry = malloc(strlen(s) + 1)) == NULL) )
X {
X if (dp)
X free(dp);
X free_dircontents(dirp -> dd_contents);
X
X return NULL;
X }
X
X if (dirp -> dd_contents)
X dirp -> dd_cp = dirp -> dd_cp -> _d_next = dp;
X else
X dirp -> dd_contents = dirp -> dd_cp = dp;
X
X strcpy(dp -> _d_entry, s);
X dp -> _d_next = NULL;
X
X dp -> _d_size = find.cbFile;
X dp -> _d_mode = find.attrFile;
X dp -> _d_time = *(unsigned *) &(find.ftimeLastWrite);
X dp -> _d_date = *(unsigned *) &(find.fdateLastWrite);
X }
X while ((s = getdirent(NULL)) != NULL);
X
X dirp -> dd_cp = dirp -> dd_contents;
X
X return dirp;
X}
X
X
Xvoid closedir(DIR * dirp)
X{
X free_dircontents(dirp -> dd_contents);
X free(dirp);
X}
X
X
Xstruct direct *readdir(DIR * dirp)
X{
X static struct direct dp;
X
X if (dirp -> dd_cp == NULL)
X return NULL;
X
X dp.d_namlen = dp.d_reclen =
X strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
X
X dp.d_ino = 0;
X
X dp.d_size = dirp -> dd_cp -> _d_size;
X dp.d_mode = dirp -> dd_cp -> _d_mode;
X dp.d_time = dirp -> dd_cp -> _d_time;
X dp.d_date = dirp -> dd_cp -> _d_date;
X
X dirp -> dd_cp = dirp -> dd_cp -> _d_next;
X dirp -> dd_loc++;
X
X return &dp;
X}
X
X
Xvoid seekdir(DIR * dirp, long off)
X{
X long i = off;
X struct _dircontents *dp;
X
X if (off >= 0)
X {
X for (dp = dirp -> dd_contents; --i >= 0 && dp; dp = dp -> _d_next);
X
X dirp -> dd_loc = off - (i + 1);
X dirp -> dd_cp = dp;
X }
X}
X
X
Xlong telldir(DIR * dirp)
X{
X return dirp -> dd_loc;
X}
X
X
Xstatic void free_dircontents(struct _dircontents * dp)
X{
X struct _dircontents *odp;
X
X while (dp)
X {
X if (dp -> _d_entry)
X free(dp -> _d_entry);
X
X dp = (odp = dp) -> _d_next;
X free(odp);
X }
X}
X
X
Xstatic
X#endif
Xint IsFileSystemFAT(char *dir)
X{
X USHORT nDrive;
X ULONG lMap;
X BYTE bData[64], bName[3];
X USHORT cbData;
X
X if ( _osmode == DOS_MODE )
X return TRUE;
X else
X {
X /* We separate FAT and HPFS file systems here.
X * Filenames read from a FAT system are converted to lower case
X * while the case of filenames read from a HPFS (and other future
X * file systems, like Unix-compatibles) is preserved.
X */
X
X if ( isalpha(dir[0]) && (dir[1] == ':') )
X nDrive = toupper(dir[0]) - '@';
X else
X DosQCurDisk(&nDrive, &lMap);
X
X bName[0] = (char) (nDrive + '@');
X bName[1] = ':';
X bName[2] = 0;
X
X cbData = sizeof(bData);
X
X if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
X return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
X else
X return FALSE;
X
X /* End of this ugly code */
X }
X}
X
X#ifndef PERLGLOB
Xstatic char *getdirent(char *dir)
X{
X int done;
X
X if (dir != NULL)
X { /* get first entry */
X lower = IsFileSystemFAT(dir);
X
X hdir = HDIR_CREATE;
X count = 1;
X done = DosFindFirst(dir, &hdir, attributes,
X &find, sizeof(find), &count, 0L);
X }
X else /* get next entry */
X done = DosFindNext(hdir, &find, sizeof(find), &count);
X
X if ( lower )
X strlwr(find.achName);
X
X if (done == 0)
X return find.achName;
X else
X {
X DosFindClose(hdir);
X return NULL;
X }
X}
X#endif
!STUFFY!FUNK!
echo Extracting makedepend.SH
sed >makedepend.SH <<'!STUFFY!FUNK!' -e 's/X//'
Xcase $CONFIG in
X'')
X if test ! -f config.sh; then
X ln ../config.sh . || \
X ln ../../config.sh . || \
X ln ../../../config.sh . || \
X (echo "Can't find config.sh."; exit 1)
X fi 2>/dev/null
X . ./config.sh
X ;;
Xesac
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
Xecho "Extracting makedepend (with variable substitutions)"
X$spitshell >makedepend <<!GROK!THIS!
X$startsh
X# $Header: makedepend.SH,v 4.0 91/03/20 01:27:04 lwall Locked $
X#
X# $Log: makedepend.SH,v $
X# Revision 4.0 91/03/20 01:27:04 lwall
X# 4.0 baseline.
X#
X#
X
Xexport PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
X
Xcat='$cat'
Xcppflags='$cppflags'
Xcp='$cp'
Xcpp='$cppstdin'
Xecho='$echo'
Xegrep='$egrep'
Xexpr='$expr'
Xmv='$mv'
Xrm='$rm'
Xsed='$sed'
Xsort='$sort'
Xtest='$test'
Xtr='$tr'
Xuniq='$uniq'
X!GROK!THIS!
X
X$spitshell >>makedepend <<'!NO!SUBS!'
X
X$cat /dev/null >.deptmp
X$rm -f *.c.c c/*.c.c
Xif test -f Makefile; then
X mf=Makefile
Xelse
X mf=makefile
Xfi
Xif test -f $mf; then
X defrule=`<$mf sed -n \
X -e '/^\.c\.o:.*;/{' \
X -e 's/\$\*\.c//' \
X -e 's/^[^;]*;[ ]*//p' \
X -e q \
X -e '}' \
X -e '/^\.c\.o: *$/{' \
X -e N \
X -e 's/\$\*\.c//' \
X -e 's/^.*\n[ ]*//p' \
X -e q \
X -e '}'`
Xfi
Xcase "$defrule" in
X'') defrule='$(CC) -c $(CFLAGS)' ;;
Xesac
X
Xmake clist || ($echo "Searching for .c files..."; \
X $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
Xfor file in `$cat .clist`; do
X# for file in `cat /dev/null`; do
X case "$file" in
X *.c) filebase=`basename $file .c` ;;
X *.y) filebase=`basename $file .c` ;;
X esac
X $echo "Finding dependencies for $filebase.o."
X $sed -n <$file >$file.c \
X -e "/^${filebase}_init(/q" \
X -e '/^#/{' \
X -e 's|/\*.*$||' \
X -e 's|\\$||' \
X -e p \
X -e '}'
X $cpp -I/usr/local/include -I. $cppflags $file.c | \
X $sed \
X -e '/^# *[0-9]/!d' \
X -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
X -e 's|: \./|: |' \
X -e 's|\.c\.c|.c|' | \
X $uniq | $sort | $uniq >> .deptmp
Xdone
X
X$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
X
Xmake shlist || ($echo "Searching for .SH files..."; \
X $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
Xif $test -s .deptmp; then
X for file in `cat .shlist`; do
X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
X /bin/sh $file >> .deptmp
X done
X $echo "Updating Makefile..."
X $echo "# If this runs make out of memory, delete /usr/include lines." \
X >> Makefile.new
X $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
X >>Makefile.new
Xelse
X make hlist || ($echo "Searching for .h files..."; \
X $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
X $echo "You don't seem to have a proper C preprocessor. Using grep instead."
X $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp
X $echo "Updating Makefile..."
X <.clist $sed -n \
X -e '/\//{' \
X -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \
X -e d \
X -e '}' \
X -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
X <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
X <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
X $sed 's|^[^;]*/||' | \
X $sed -f .hsed >> Makefile.new
X <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
X >> Makefile.new
X <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
X $sed -f .hsed >> Makefile.new
X <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
X >> Makefile.new
X for file in `$cat .shlist`; do
X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
X /bin/sh $file >> Makefile.new
X done
Xfi
X$rm -f Makefile.old
X$cp Makefile Makefile.old
X$cp Makefile.new Makefile
X$rm Makefile.new
X$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
X$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
X
X!NO!SUBS!
X$eunicefix makedepend
Xchmod +x makedepend
Xcase `pwd` in
X*SH)
X $rm -f ../makedepend
X ln makedepend ../makedepend
X ;;
Xesac
!STUFFY!FUNK!
echo " "
echo "End of kit 30 (of 36)"
cat /dev/null >kit30isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
for combo in *:AA; do
if test -f "$combo"; then
realfile=`basename $combo :AA`
cat $realfile:[A-Z][A-Z] >$realfile
rm -rf $realfile:[A-Z][A-Z]
fi
done
rm -rf kit*isdone
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
exit 0 # Just in case...
--
Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.