home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume18 / perl / part30 < prev    next >
Internet Message Format  |  1991-04-17  |  51KB
  1. From: lwall@netlabs.com (Larry Wall)
  2. Newsgroups: comp.sources.misc
  3. Subject: v18i048:  perl - The perl programming language, Part30/36
  4. Message-ID: <1991Apr17.185832.2834@sparky.IMD.Sterling.COM>
  5. Date: 17 Apr 91 18:58:32 GMT
  6. Approved: kent@sparky.imd.sterling.com
  7. X-Checksum-Snefru: dbb0bc80 0eaf4762 315e6020 2cf4e6d7
  8.  
  9. Submitted-by: Larry Wall <lwall@netlabs.com>
  10. Posting-number: Volume 18, Issue 48
  11. Archive-name: perl/part30
  12.  
  13. [There are 36 kits for perl version 4.0.]
  14.  
  15. #! /bin/sh
  16.  
  17. # Make a new directory for the perl sources, cd to it, and run kits 1
  18. # thru 36 through sh.  When all 36 kits have been run, read README.
  19.  
  20. echo "This is perl 4.0 kit 30 (of 36).  If kit 30 is complete, the line"
  21. echo '"'"End of kit 30 (of 36)"'" will echo at the end.'
  22. echo ""
  23. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  24. mkdir eg eg/scan lib msdos os2 t t/op x2p 2>/dev/null
  25. echo Extracting os2/os2.c
  26. sed >os2/os2.c <<'!STUFFY!FUNK!' -e 's/X//'
  27. X/* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $
  28. X *
  29. X *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  30. X *
  31. X *    You may distribute under the terms of the GNU General Public License
  32. X *    as specified in the README file that comes with the perl 3.0 kit.
  33. X *
  34. X * $Log:    os2.c,v $
  35. X * Revision 4.0  91/03/20  01:36:21  lwall
  36. X * 4.0 baseline.
  37. X * 
  38. X * Revision 3.0.1.2  90/11/10  01:42:38  lwall
  39. X * patch38: more msdos/os2 upgrades
  40. X * 
  41. X * Revision 3.0.1.1  90/10/15  17:49:55  lwall
  42. X * patch29: Initial revision
  43. X * 
  44. X * Revision 3.0.1.1  90/03/27  16:10:41  lwall
  45. X * patch16: MSDOS support
  46. X *
  47. X * Revision 1.1  90/03/18  20:32:01  dds
  48. X * Initial revision
  49. X *
  50. X */
  51. X
  52. X#define INCL_DOS
  53. X#define INCL_NOPM
  54. X#include <os2.h>
  55. X
  56. X/*
  57. X * Various Unix compatibility functions for OS/2
  58. X */
  59. X
  60. X#include <stdio.h>
  61. X#include <errno.h>
  62. X#include <process.h>
  63. X
  64. X#include "EXTERN.h"
  65. X#include "perl.h"
  66. X
  67. X
  68. X/* dummies */
  69. X
  70. Xint ioctl(int handle, unsigned int function, char *data)
  71. X{ return -1; }
  72. X
  73. Xint userinit()
  74. X{ return -1; }
  75. X
  76. Xint syscall()
  77. X{ return -1; }
  78. X
  79. X
  80. X/* extendd chdir() */
  81. X
  82. Xint chdir(char *path)
  83. X{
  84. X  if ( path[0] != 0 && path[1] == ':' )
  85. X    DosSelectDisk(toupper(path[0]) - '@');
  86. X
  87. X  DosChDir(path, 0L);
  88. X}
  89. X
  90. X
  91. X/* priorities */
  92. X
  93. Xint setpriority(int class, int pid, int val)
  94. X{
  95. X  int flag = 0;
  96. X
  97. X  if ( pid < 0 )
  98. X  {
  99. X    flag++;
  100. X    pid = -pid;
  101. X  }
  102. X
  103. X  return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid);
  104. X}
  105. X
  106. Xint getpriority(int which /* ignored */, int pid)
  107. X{
  108. X  USHORT val;
  109. X
  110. X  if ( DosGetPrty(PRTYS_PROCESS, &val, pid) )
  111. X    return -1;
  112. X  else
  113. X    return val;
  114. X}
  115. X
  116. X
  117. X/* get parent process id */
  118. X
  119. Xint getppid(void)
  120. X{
  121. X  PIDINFO pi;
  122. X
  123. X  DosGetPID(&pi);
  124. X  return pi.pidParent;
  125. X}
  126. X
  127. X
  128. X/* kill */
  129. X
  130. Xint kill(int pid, int sig)
  131. X{
  132. X  int flag = 0;
  133. X
  134. X  if ( pid < 0 )
  135. X  {
  136. X    flag++;
  137. X    pid = -pid;
  138. X  }
  139. X
  140. X  switch ( sig & 3 )
  141. X  {
  142. X
  143. X  case 0:
  144. X    DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid);
  145. X    break;
  146. X
  147. X  case 1: /* FLAG A */
  148. X    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0);
  149. X    break;
  150. X
  151. X  case 2: /* FLAG B */
  152. X    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0);
  153. X    break;
  154. X
  155. X  case 3: /* FLAG C */
  156. X    DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0);
  157. X    break;
  158. X
  159. X  }
  160. X}
  161. X
  162. X
  163. X/* Sleep function. */
  164. Xvoid
  165. Xsleep(unsigned len)
  166. X{
  167. X   DosSleep(len * 1000L);
  168. X}
  169. X
  170. X/* Just pretend that everyone is a superuser */
  171. X
  172. Xint setuid()
  173. X{ return 0; }
  174. X
  175. Xint setgid()
  176. X{ return 0; }
  177. X
  178. Xint getuid(void)
  179. X{ return 0; }
  180. X
  181. Xint geteuid(void)
  182. X{ return 0; }
  183. X
  184. Xint getgid(void)
  185. X{ return 0; }
  186. X
  187. Xint getegid(void)
  188. X{ return 0; }
  189. X
  190. X/*
  191. X * The following code is based on the do_exec and do_aexec functions
  192. X * in file doio.c
  193. X */
  194. Xint
  195. Xdo_aspawn(really,arglast)
  196. XSTR *really;
  197. Xint *arglast;
  198. X{
  199. X    register STR **st = stack->ary_array;
  200. X    register int sp = arglast[1];
  201. X    register int items = arglast[2] - sp;
  202. X    register char **a;
  203. X    char **argv;
  204. X    char *tmps;
  205. X    int status;
  206. X
  207. X    if (items) {
  208. X    New(1101,argv, items+1, char*);
  209. X    a = argv;
  210. X    for (st += ++sp; items > 0; items--,st++) {
  211. X        if (*st)
  212. X        *a++ = str_get(*st);
  213. X        else
  214. X        *a++ = "";
  215. X    }
  216. X    *a = Nullch;
  217. X    if (really && *(tmps = str_get(really)))
  218. X        status = spawnvp(P_WAIT,tmps,argv);
  219. X    else
  220. X        status = spawnvp(P_WAIT,argv[0],argv);
  221. X    Safefree(argv);
  222. X    }
  223. X    return status;
  224. X}
  225. X
  226. Xchar *getenv(char *name);
  227. X
  228. Xint
  229. Xdo_spawn(cmd)
  230. Xchar *cmd;
  231. X{
  232. X    register char **a;
  233. X    register char *s;
  234. X    char **argv;
  235. X    char flags[10];
  236. X    int status;
  237. X    char *shell, *cmd2;
  238. X
  239. X    /* save an extra exec if possible */
  240. X    if ((shell = getenv("COMSPEC")) == 0)
  241. X    shell = "C:\\OS2\\CMD.EXE";
  242. X
  243. X    /* see if there are shell metacharacters in it */
  244. X    if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|')
  245. X        || strchr(cmd, '&') || strchr(cmd, '^'))
  246. X      doshell:
  247. X        return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0);
  248. X
  249. X    New(1102,argv, strlen(cmd) / 2 + 2, char*);
  250. X
  251. X    New(1103,cmd2, strlen(cmd) + 1, char);
  252. X    strcpy(cmd2, cmd);
  253. X    a = argv;
  254. X    for (s = cmd2; *s;) {
  255. X    while (*s && isspace(*s)) s++;
  256. X    if (*s)
  257. X        *(a++) = s;
  258. X    while (*s && !isspace(*s)) s++;
  259. X    if (*s)
  260. X        *s++ = '\0';
  261. X    }
  262. X    *a = Nullch;
  263. X    if (argv[0])
  264. X    if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
  265. X        Safefree(argv);
  266. X        Safefree(cmd2);
  267. X        goto doshell;
  268. X    }
  269. X    Safefree(cmd2);
  270. X    Safefree(argv);
  271. X    return status;
  272. X}
  273. X
  274. Xusage(char *myname)
  275. X{
  276. X#ifdef MSDOS
  277. X  printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
  278. X#else
  279. X  printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
  280. X#endif
  281. X         "\n            [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname);
  282. X
  283. X  printf("\n  -a  autosplit mode with -n or -p"
  284. X         "\n  -c  syntaxcheck only"
  285. X         "\n  -d  run scripts under debugger"
  286. X         "\n  -n  assume 'while (<>) { ...script... }' loop arround your script"
  287. X         "\n  -p  assume loop like -n but print line also like sed"
  288. X#ifndef MSDOS
  289. X         "\n  -P  run script through C preprocessor befor compilation"
  290. X#endif
  291. X         "\n  -s  enable some switch parsing for switches after script name"
  292. X         "\n  -S  look for the script using PATH environment variable");
  293. X#ifndef MSDOS
  294. X  printf("\n  -u  dump core after compiling the script"
  295. X         "\n  -U  allow unsafe operations");
  296. X#endif
  297. X  printf("\n  -v  print version number and patchlevel of perl"
  298. X         "\n  -w  turn warnings on for compilation of your script\n"
  299. X         "\n  -0[octal]       specify record separator (0, if no argument)"
  300. X         "\n  -Dnumber        set debugging flags (argument is a bit mask)"
  301. X         "\n  -i[extension]   edit <> files in place (make backup if extension supplied)"
  302. X         "\n  -Idirectory     specify include directory in conjunction with -P"
  303. X         "\n  -e command      one line of script, multiple -e options are allowed"
  304. X         "\n                  [filename] can be ommitted, when -e is used"
  305. X         "\n  -x[directory]   strip off text before #!perl line and perhaps cd to directory\n");
  306. X}
  307. !STUFFY!FUNK!
  308. echo Extracting lib/syslog.pl
  309. sed >lib/syslog.pl <<'!STUFFY!FUNK!' -e 's/X//'
  310. X#
  311. X# syslog.pl
  312. X#
  313. X# $Log:    syslog.pl,v $
  314. X# Revision 4.0  91/03/20  01:26:24  lwall
  315. X# 4.0 baseline.
  316. X# 
  317. X# Revision 3.0.1.4  90/11/10  01:41:11  lwall
  318. X# patch38: syslog.pl was referencing an absolute path
  319. X# 
  320. X# Revision 3.0.1.3  90/10/15  17:42:18  lwall
  321. X# patch29: various portability fixes
  322. X# 
  323. X# Revision 3.0.1.1  90/08/09  03:57:17  lwall
  324. X# patch19: Initial revision
  325. X# 
  326. X# Revision 1.2  90/06/11  18:45:30  18:45:30  root ()
  327. X# - Changed 'warn' to 'mail|warning' in test call (to give example of
  328. X#   facility specification, and because 'warn' didn't work on HP-UX).
  329. X# - Fixed typo in &openlog ("ncons" should be "cons").
  330. X# - Added (package-global) $maskpri, and &setlogmask.
  331. X# - In &syslog:
  332. X#   - put argument test ahead of &connect (why waste cycles?),
  333. X#   - allowed facility to be specified in &syslog's first arg (temporarily
  334. X#     overrides any $facility set in &openlog), just as in syslog(3C),
  335. X#   - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)),
  336. X#   - changed $whoami code to use getlogin, getpwuid($<) and 'syslog'
  337. X#     (in that order) when $ident is null,
  338. X#   - made PID logging consistent with syslog(3C) and subject to $lo_pid only,
  339. X#   - fixed typo in "print CONS" statement ($<facility should be <$facility).
  340. X#   - changed \n to \r in print CONS (\r is useful, $message already has a \n).
  341. X# - Changed &xlate to return -1 for an unknown name, instead of croaking.
  342. X# 
  343. X#
  344. X# tom christiansen <tchrist@convex.com>
  345. X# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  346. X# NOTE: openlog now takes three arguments, just like openlog(3)
  347. X#
  348. X# call syslog() with a string priority and a list of printf() args
  349. X# like syslog(3)
  350. X#
  351. X#  usage: require 'syslog.pl';
  352. X#
  353. X#  then (put these all in a script to test function)
  354. X#        
  355. X#
  356. X#    do openlog($program,'cons,pid','user');
  357. X#    do syslog('info','this is another test');
  358. X#    do syslog('mail|warning','this is a better test: %d', time);
  359. X#    do closelog();
  360. X#    
  361. X#    do syslog('debug','this is the last test');
  362. X#    do openlog("$program $$",'ndelay','user');
  363. X#    do syslog('notice','fooprogram: this is really done');
  364. X#
  365. X#    $! = 55;
  366. X#    do syslog('info','problem was %m'); # %m == $! in syslog(3)
  367. X
  368. Xpackage syslog;
  369. X
  370. X$host = 'localhost' unless $host;    # set $syslog'host to change
  371. X
  372. Xrequire 'syslog.ph';
  373. X
  374. X$maskpri = &LOG_UPTO(&LOG_DEBUG);
  375. X
  376. Xsub main'openlog {
  377. X    ($ident, $logopt, $facility) = @_;  # package vars
  378. X    $lo_pid = $logopt =~ /\bpid\b/;
  379. X    $lo_ndelay = $logopt =~ /\bndelay\b/;
  380. X    $lo_cons = $logopt =~ /\bcons\b/;
  381. X    $lo_nowait = $logopt =~ /\bnowait\b/;
  382. X    &connect if $lo_ndelay;
  383. X} 
  384. X
  385. Xsub main'closelog {
  386. X    $facility = $ident = '';
  387. X    &disconnect;
  388. X} 
  389. X
  390. Xsub main'setlogmask {
  391. X    local($oldmask) = $maskpri;
  392. X    $maskpri = shift;
  393. X    $oldmask;
  394. X}
  395. X 
  396. Xsub main'syslog {
  397. X    local($priority) = shift;
  398. X    local($mask) = shift;
  399. X    local($message, $whoami);
  400. X    local(@words, $num, $numpri, $numfac, $sum);
  401. X    local($facility) = $facility;    # may need to change temporarily.
  402. X
  403. X    die "syslog: expected both priority and mask" unless $mask && $priority;
  404. X
  405. X    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
  406. X    undef $numpri;
  407. X    undef $numfac;
  408. X    foreach (@words) {
  409. X    $num = &xlate($_);        # Translate word to number.
  410. X    if (/^kern$/ || $num < 0) {
  411. X        die "syslog: invalid level/facility: $_\n";
  412. X    }
  413. X    elsif ($num <= &LOG_PRIMASK) {
  414. X        die "syslog: too many levels given: $_\n" if defined($numpri);
  415. X        $numpri = $num;
  416. X        return 0 unless &LOG_MASK($numpri) & $maskpri;
  417. X    }
  418. X    else {
  419. X        die "syslog: too many facilities given: $_\n" if defined($numfac);
  420. X        $facility = $_;
  421. X        $numfac = $num;
  422. X    }
  423. X    }
  424. X
  425. X    die "syslog: level must be given\n" unless defined($numpri);
  426. X
  427. X    if (!defined($numfac)) {    # Facility not specified in this call.
  428. X    $facility = 'user' unless $facility;
  429. X    $numfac = &xlate($facility);
  430. X    }
  431. X
  432. X    &connect unless $connected;
  433. X
  434. X    $whoami = $ident;
  435. X
  436. X    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
  437. X    $whoami = $1;
  438. X    $mask = $2;
  439. X    } 
  440. X
  441. X    unless ($whoami) {
  442. X    ($whoami = getlogin) ||
  443. X        ($whoami = getpwuid($<)) ||
  444. X        ($whoami = 'syslog');
  445. X    }
  446. X
  447. X    $whoami .= "[$$]" if $lo_pid;
  448. X
  449. X    $mask =~ s/%m/$!/g;
  450. X    $mask .= "\n" unless $mask =~ /\n$/;
  451. X    $message = sprintf ($mask, @_);
  452. X
  453. X    $sum = $numpri + $numfac;
  454. X    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
  455. X    if ($lo_cons) {
  456. X        if ($pid = fork) {
  457. X        unless ($lo_nowait) {
  458. X            do {$died = wait;} until $died == $pid || $died < 0;
  459. X        }
  460. X        }
  461. X        else {
  462. X        open(CONS,">/dev/console");
  463. X        print CONS "<$facility.$priority>$whoami: $message\r";
  464. X        exit if defined $pid;        # if fork failed, we're parent
  465. X        close CONS;
  466. X        }
  467. X    }
  468. X    }
  469. X}
  470. X
  471. Xsub xlate {
  472. X    local($name) = @_;
  473. X    $name =~ y/a-z/A-Z/;
  474. X    $name = "LOG_$name" unless $name =~ /^LOG_/;
  475. X    $name = "syslog'$name";
  476. X    eval &$name || -1;
  477. X}
  478. X
  479. Xsub connect {
  480. X    $pat = 'S n C4 x8';
  481. X
  482. X    $af_unix = 1;
  483. X    $af_inet = 2;
  484. X
  485. X    $stream = 1;
  486. X    $datagram = 2;
  487. X
  488. X    ($name,$aliases,$proto) = getprotobyname('udp');
  489. X    $udp = $proto;
  490. X
  491. X    ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
  492. X    $syslog = $port;
  493. X
  494. X    if (chop($myname = `hostname`)) {
  495. X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
  496. X    die "Can't lookup $myname\n" unless $name;
  497. X    @bytes = unpack("C4",$addrs[0]);
  498. X    }
  499. X    else {
  500. X    @bytes = (0,0,0,0);
  501. X    }
  502. X    $this = pack($pat, $af_inet, 0, @bytes);
  503. X
  504. X    if ($host =~ /^\d+\./) {
  505. X    @bytes = split(/\./,$host);
  506. X    }
  507. X    else {
  508. X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
  509. X    die "Can't lookup $host\n" unless $name;
  510. X    @bytes = unpack("C4",$addrs[0]);
  511. X    }
  512. X    $that = pack($pat,$af_inet,$syslog,@bytes);
  513. X
  514. X    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
  515. X    bind(SYSLOG,$this) || die "bind: $!\n";
  516. X    connect(SYSLOG,$that) || die "connect: $!\n";
  517. X
  518. X    local($old) = select(SYSLOG); $| = 1; select($old);
  519. X    $connected = 1;
  520. X}
  521. X
  522. Xsub disconnect {
  523. X    close SYSLOG;
  524. X    $connected = 0;
  525. X}
  526. X
  527. X1;
  528. !STUFFY!FUNK!
  529. echo Extracting array.c
  530. sed >array.c <<'!STUFFY!FUNK!' -e 's/X//'
  531. X/* $Header: array.c,v 4.0 91/03/20 01:03:32 lwall Locked $
  532. X *
  533. X *    Copyright (c) 1989, Larry Wall
  534. X *
  535. X *    You may distribute under the terms of the GNU General Public License
  536. X *    as specified in the README file that comes with the perl 3.0 kit.
  537. X *
  538. X * $Log:    array.c,v $
  539. X * Revision 4.0  91/03/20  01:03:32  lwall
  540. X * 4.0 baseline.
  541. X * 
  542. X */
  543. X
  544. X#include "EXTERN.h"
  545. X#include "perl.h"
  546. X
  547. XSTR *
  548. Xafetch(ar,key,lval)
  549. Xregister ARRAY *ar;
  550. Xint key;
  551. Xint lval;
  552. X{
  553. X    STR *str;
  554. X
  555. X    if (key < 0 || key > ar->ary_fill) {
  556. X    if (lval && key >= 0) {
  557. X        if (ar->ary_flags & ARF_REAL)
  558. X        str = Str_new(5,0);
  559. X        else
  560. X        str = str_mortal(&str_undef);
  561. X        (void)astore(ar,key,str);
  562. X        return str;
  563. X    }
  564. X    else
  565. X        return &str_undef;
  566. X    }
  567. X    if (!ar->ary_array[key]) {
  568. X    if (lval) {
  569. X        str = Str_new(6,0);
  570. X        (void)astore(ar,key,str);
  571. X        return str;
  572. X    }
  573. X    return &str_undef;
  574. X    }
  575. X    return ar->ary_array[key];
  576. X}
  577. X
  578. Xbool
  579. Xastore(ar,key,val)
  580. Xregister ARRAY *ar;
  581. Xint key;
  582. XSTR *val;
  583. X{
  584. X    int retval;
  585. X
  586. X    if (key < 0)
  587. X    return FALSE;
  588. X    if (key > ar->ary_max) {
  589. X    int newmax;
  590. X
  591. X    if (ar->ary_alloc != ar->ary_array) {
  592. X        retval = ar->ary_array - ar->ary_alloc;
  593. X        Copy(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*);
  594. X        Zero(ar->ary_alloc+ar->ary_max+1, retval, STR*);
  595. X        ar->ary_max += retval;
  596. X        ar->ary_array -= retval;
  597. X        if (key > ar->ary_max - 10) {
  598. X        newmax = key + ar->ary_max;
  599. X        goto resize;
  600. X        }
  601. X    }
  602. X    else {
  603. X        if (ar->ary_alloc) {
  604. X        newmax = key + ar->ary_max / 5;
  605. X          resize:
  606. X        Renew(ar->ary_alloc,newmax+1, STR*);
  607. X        Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*);
  608. X        }
  609. X        else {
  610. X        newmax = key < 4 ? 4 : key;
  611. X        Newz(2,ar->ary_alloc, newmax+1, STR*);
  612. X        }
  613. X        ar->ary_array = ar->ary_alloc;
  614. X        ar->ary_max = newmax;
  615. X    }
  616. X    }
  617. X    if ((ar->ary_flags & ARF_REAL) && ar->ary_fill < key) {
  618. X    while (++ar->ary_fill < key) {
  619. X        if (ar->ary_array[ar->ary_fill] != Nullstr) {
  620. X        str_free(ar->ary_array[ar->ary_fill]);
  621. X        ar->ary_array[ar->ary_fill] = Nullstr;
  622. X        }
  623. X    }
  624. X    }
  625. X    retval = (ar->ary_array[key] != Nullstr);
  626. X    if (retval && (ar->ary_flags & ARF_REAL))
  627. X    str_free(ar->ary_array[key]);
  628. X    ar->ary_array[key] = val;
  629. X    return retval;
  630. X}
  631. X
  632. XARRAY *
  633. Xanew(stab)
  634. XSTAB *stab;
  635. X{
  636. X    register ARRAY *ar;
  637. X
  638. X    New(1,ar,1,ARRAY);
  639. X    ar->ary_magic = Str_new(7,0);
  640. X    ar->ary_alloc = ar->ary_array = 0;
  641. X    str_magic(ar->ary_magic, stab, '#', Nullch, 0);
  642. X    ar->ary_max = ar->ary_fill = -1;
  643. X    ar->ary_flags = ARF_REAL;
  644. X    return ar;
  645. X}
  646. X
  647. XARRAY *
  648. Xafake(stab,size,strp)
  649. XSTAB *stab;
  650. Xregister int size;
  651. Xregister STR **strp;
  652. X{
  653. X    register ARRAY *ar;
  654. X
  655. X    New(3,ar,1,ARRAY);
  656. X    New(4,ar->ary_alloc,size+1,STR*);
  657. X    Copy(strp,ar->ary_alloc,size,STR*);
  658. X    ar->ary_array = ar->ary_alloc;
  659. X    ar->ary_magic = Str_new(8,0);
  660. X    str_magic(ar->ary_magic, stab, '#', Nullch, 0);
  661. X    ar->ary_fill = size - 1;
  662. X    ar->ary_max = size - 1;
  663. X    ar->ary_flags = 0;
  664. X    while (size--) {
  665. X    (*strp++)->str_pok &= ~SP_TEMP;
  666. X    }
  667. X    return ar;
  668. X}
  669. X
  670. Xvoid
  671. Xaclear(ar)
  672. Xregister ARRAY *ar;
  673. X{
  674. X    register int key;
  675. X
  676. X    if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0)
  677. X    return;
  678. X    if (key = ar->ary_array - ar->ary_alloc) {
  679. X    ar->ary_max += key;
  680. X    ar->ary_array -= key;
  681. X    }
  682. X    for (key = 0; key <= ar->ary_max; key++)
  683. X    str_free(ar->ary_array[key]);
  684. X    ar->ary_fill = -1;
  685. X    Zero(ar->ary_array, ar->ary_max+1, STR*);
  686. X}
  687. X
  688. Xvoid
  689. Xafree(ar)
  690. Xregister ARRAY *ar;
  691. X{
  692. X    register int key;
  693. X
  694. X    if (!ar)
  695. X    return;
  696. X    if (key = ar->ary_array - ar->ary_alloc) {
  697. X    ar->ary_max += key;
  698. X    ar->ary_array -= key;
  699. X    }
  700. X    if (ar->ary_flags & ARF_REAL) {
  701. X    for (key = 0; key <= ar->ary_max; key++)
  702. X        str_free(ar->ary_array[key]);
  703. X    }
  704. X    str_free(ar->ary_magic);
  705. X    Safefree(ar->ary_alloc);
  706. X    Safefree(ar);
  707. X}
  708. X
  709. Xbool
  710. Xapush(ar,val)
  711. Xregister ARRAY *ar;
  712. XSTR *val;
  713. X{
  714. X    return astore(ar,++(ar->ary_fill),val);
  715. X}
  716. X
  717. XSTR *
  718. Xapop(ar)
  719. Xregister ARRAY *ar;
  720. X{
  721. X    STR *retval;
  722. X
  723. X    if (ar->ary_fill < 0)
  724. X    return Nullstr;
  725. X    retval = ar->ary_array[ar->ary_fill];
  726. X    ar->ary_array[ar->ary_fill--] = Nullstr;
  727. X    return retval;
  728. X}
  729. X
  730. Xaunshift(ar,num)
  731. Xregister ARRAY *ar;
  732. Xregister int num;
  733. X{
  734. X    register int i;
  735. X    register STR **sstr,**dstr;
  736. X
  737. X    if (num <= 0)
  738. X    return;
  739. X    if (ar->ary_array - ar->ary_alloc >= num) {
  740. X    ar->ary_max += num;
  741. X    ar->ary_fill += num;
  742. X    while (num--)
  743. X        *--ar->ary_array = Nullstr;
  744. X    }
  745. X    else {
  746. X    (void)astore(ar,ar->ary_fill+num,(STR*)0);    /* maybe extend array */
  747. X    dstr = ar->ary_array + ar->ary_fill;
  748. X    sstr = dstr - num;
  749. X#ifdef BUGGY_MSC5
  750. X # pragma loop_opt(off)    /* don't loop-optimize the following code */
  751. X#endif /* BUGGY_MSC5 */
  752. X    for (i = ar->ary_fill; i >= 0; i--) {
  753. X        *dstr-- = *sstr--;
  754. X#ifdef BUGGY_MSC5
  755. X # pragma loop_opt()    /* loop-optimization back to command-line setting */
  756. X#endif /* BUGGY_MSC5 */
  757. X    }
  758. X    Zero(ar->ary_array, num, STR*);
  759. X    }
  760. X}
  761. X
  762. XSTR *
  763. Xashift(ar)
  764. Xregister ARRAY *ar;
  765. X{
  766. X    STR *retval;
  767. X
  768. X    if (ar->ary_fill < 0)
  769. X    return Nullstr;
  770. X    retval = *ar->ary_array;
  771. X    *(ar->ary_array++) = Nullstr;
  772. X    ar->ary_max--;
  773. X    ar->ary_fill--;
  774. X    return retval;
  775. X}
  776. X
  777. Xint
  778. Xalen(ar)
  779. Xregister ARRAY *ar;
  780. X{
  781. X    return ar->ary_fill;
  782. X}
  783. X
  784. Xafill(ar, fill)
  785. Xregister ARRAY *ar;
  786. Xint fill;
  787. X{
  788. X    if (fill < 0)
  789. X    fill = -1;
  790. X    if (fill <= ar->ary_max)
  791. X    ar->ary_fill = fill;
  792. X    else
  793. X    (void)astore(ar,fill,Nullstr);
  794. X}
  795. !STUFFY!FUNK!
  796. echo Extracting t/op/stat.t
  797. sed >t/op/stat.t <<'!STUFFY!FUNK!' -e 's/X//'
  798. X#!./perl
  799. X
  800. X# $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $
  801. X
  802. Xprint "1..56\n";
  803. X
  804. Xchop($cwd = `pwd`);
  805. X
  806. Xunlink "Op.stat.tmp";
  807. Xopen(foo, ">Op.stat.tmp");
  808. X
  809. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  810. X    $blksize,$blocks) = stat(foo);
  811. Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
  812. Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
  813. X
  814. Xprint foo "Now is the time for all good men to come to.\n";
  815. Xclose(foo);
  816. X
  817. Xsleep 2;
  818. X
  819. X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
  820. X
  821. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  822. X    $blksize,$blocks) = stat('Op.stat.tmp');
  823. X
  824. Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
  825. Xif (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) {
  826. X    print "ok 4\n";
  827. X}
  828. Xelse {
  829. X    print "not ok 4\n";
  830. X}
  831. Xprint "#4    :$mtime: != :$ctime:\n";
  832. X
  833. X`cp /dev/null Op.stat.tmp`;
  834. X
  835. Xif (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
  836. Xif (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
  837. X
  838. X`echo hi >Op.stat.tmp`;
  839. Xif (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
  840. Xif (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
  841. X
  842. Xunlink 'Op.stat.tmp';
  843. X$olduid = $>;        # can't test -r if uid == 0
  844. X`echo hi >Op.stat.tmp`;
  845. Xchmod 0,'Op.stat.tmp';
  846. Xeval '$> = 1;';        # so switch uid (may not be implemented)
  847. Xif (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
  848. Xif (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
  849. Xeval '$> = $olduid;';        # switch uid back (may not be implemented)
  850. Xprint "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
  851. Xif (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";}
  852. X
  853. Xforeach ((12,13,14,15,16,17)) {
  854. X    print "ok $_\n";        #deleted tests
  855. X}
  856. X
  857. Xchmod 0700,'Op.stat.tmp';
  858. Xif (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
  859. Xif (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
  860. Xif (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
  861. X
  862. Xif (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
  863. Xif (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
  864. X
  865. Xif (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
  866. Xif (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
  867. X
  868. Xif (`ls -l perl` =~ /^l.*->/) {
  869. X    if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
  870. X}
  871. Xelse {
  872. X    print "ok 25\n";
  873. X}
  874. X
  875. Xif (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
  876. X
  877. Xif (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
  878. X`rm -f Op.stat.tmp Op.stat.tmp2`;
  879. Xif (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
  880. X
  881. Xif (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
  882. Xif (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
  883. X
  884. Xif (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
  885. X    {print "ok 31\n";}
  886. Xelse
  887. X    {print "not ok 31\n";}
  888. Xif (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
  889. X
  890. Xif (! -e '/dev/mt0' || -b '/dev/mt0')
  891. X    {print "ok 33\n";}
  892. Xelse
  893. X    {print "not ok 33\n";}
  894. Xif (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
  895. X
  896. X$cnt = $uid = 0;
  897. X
  898. Xdie "Can't run op/stat.t test 35 without pwd working" unless $cwd;
  899. Xchdir '/usr/bin' || die "Can't cd to /usr/bin";
  900. Xwhile (defined($_ = <*>)) {
  901. X    $cnt++;
  902. X    $uid++ if -u;
  903. X    last if $uid && $uid < $cnt;
  904. X}
  905. Xchdir $cwd || die "Can't cd back to $cwd";
  906. X
  907. X# I suppose this is going to fail somewhere...
  908. Xif ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
  909. X
  910. Xunless (open(tty,"/dev/tty")) {
  911. X    print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
  912. X}
  913. Xif (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
  914. Xif (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
  915. Xclose(tty);
  916. Xif (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
  917. Xopen(null,"/dev/null");
  918. Xif (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";}
  919. Xclose(null);
  920. Xif (-t) {print "ok 40\n";} else {print "not ok 40\n";}
  921. X
  922. X# These aren't strictly "stat" calls, but so what?
  923. X
  924. Xif (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
  925. Xif (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
  926. X
  927. Xif (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
  928. Xif (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
  929. X
  930. Xopen(foo,'op/stat.t');
  931. Xif (-T foo) {print "ok 45\n";} else {print "not ok 45\n";}
  932. Xif (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";}
  933. X$_ = <foo>;
  934. Xif (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
  935. Xif (-T foo) {print "ok 48\n";} else {print "not ok 48\n";}
  936. Xif (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";}
  937. Xclose(foo);
  938. X
  939. Xopen(foo,'op/stat.t');
  940. X$_ = <foo>;
  941. Xif (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
  942. Xif (-T foo) {print "ok 51\n";} else {print "not ok 51\n";}
  943. Xif (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";}
  944. Xseek(foo,0,0);
  945. Xif (-T foo) {print "ok 53\n";} else {print "not ok 53\n";}
  946. Xif (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";}
  947. Xclose(foo);
  948. X
  949. Xif (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
  950. Xif (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
  951. !STUFFY!FUNK!
  952. echo Extracting msdos/msdos.c
  953. sed >msdos/msdos.c <<'!STUFFY!FUNK!' -e 's/X//'
  954. X/* $Header: msdos.c,v 4.0 91/03/20 01:34:46 lwall Locked $
  955. X *
  956. X *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  957. X *
  958. X *    You may distribute under the terms of the GNU General Public License
  959. X *    as specified in the README file that comes with the perl 3.0 kit.
  960. X *
  961. X * $Log:    msdos.c,v $
  962. X * Revision 4.0  91/03/20  01:34:46  lwall
  963. X * 4.0 baseline.
  964. X * 
  965. X * Revision 3.0.1.1  90/03/27  16:10:41  lwall
  966. X * patch16: MSDOS support
  967. X * 
  968. X * Revision 1.1  90/03/18  20:32:01  dds
  969. X * Initial revision
  970. X *
  971. X */
  972. X
  973. X/*
  974. X * Various Unix compatibility functions for MS-DOS.
  975. X */
  976. X
  977. X#include "EXTERN.h"
  978. X#include "perl.h"
  979. X
  980. X#include <dos.h>
  981. X#include <process.h>
  982. X
  983. X/*
  984. X * Interface to the MS-DOS ioctl system call.
  985. X * The function is encoded as follows:
  986. X * The lowest nibble of the function code goes to AL
  987. X * The two middle nibbles go to CL
  988. X * The high nibble goes to CH
  989. X *
  990. X * The return code is -1 in the case of an error and if successful
  991. X * for functions AL = 00, 09, 0a the value of the register DX
  992. X * for functions AL = 02 - 08, 0e the value of the register AX
  993. X * for functions AL = 01, 0b - 0f the number 0
  994. X *
  995. X * Notice that this restricts the ioctl subcodes stored in AL to 00-0f
  996. X * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f
  997. X * so we are ok.
  998. X * Furthermore CH is also restriced in the same area.  Where CH is used as a
  999. X * code it always is between 00-0f.  In the case where it forms a count
  1000. X * together with CL we arbitrarily set the highest count limit to 4095.  It
  1001. X * sounds reasonable for an ioctl.
  1002. X * The other alternative would have been to use the pointer argument to
  1003. X * point the the values of CX.  The problem with this approach is that
  1004. X * of accessing wild regions when DX is used as a number and not as a
  1005. X * pointer.
  1006. X */
  1007. Xint
  1008. Xioctl(int handle, unsigned int function, char *data)
  1009. X{
  1010. X    union REGS      srv;
  1011. X    struct SREGS    segregs;
  1012. X
  1013. X    srv.h.ah = 0x44;
  1014. X    srv.h.al = (unsigned char)(function & 0x0F);
  1015. X    srv.x.bx = handle;
  1016. X    srv.x.cx = function >> 4;
  1017. X    segread(&segregs);
  1018. X#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
  1019. X    segregs.ds = FP_SEG(data);
  1020. X    srv.x.dx = FP_OFF(data);
  1021. X#else
  1022. X    srv.x.dx = (unsigned int) data;
  1023. X#endif
  1024. X    intdosx(&srv, &srv, &segregs);
  1025. X    if (srv.x.cflag & 1) {
  1026. X        switch(srv.x.ax ){
  1027. X        case 1:
  1028. X            errno = EINVAL;
  1029. X            break;
  1030. X        case 2:
  1031. X        case 3:
  1032. X            errno = ENOENT;
  1033. X            break;
  1034. X        case 4:
  1035. X            errno = EMFILE;
  1036. X            break;
  1037. X        case 5:
  1038. X            errno = EPERM;
  1039. X            break;
  1040. X        case 6:
  1041. X            errno = EBADF;
  1042. X            break;
  1043. X        case 8:
  1044. X            errno = ENOMEM;
  1045. X            break;
  1046. X        case 0xc:
  1047. X        case 0xd:
  1048. X        case 0xf:
  1049. X            errno = EINVAL;
  1050. X            break;
  1051. X        case 0x11:
  1052. X            errno = EXDEV;
  1053. X            break;
  1054. X        case 0x12:
  1055. X            errno = ENFILE;
  1056. X            break;
  1057. X        default:
  1058. X            errno = EZERO;
  1059. X            break;
  1060. X        }
  1061. X        return -1;
  1062. X    } else {
  1063. X        switch (function & 0xf) {
  1064. X        case 0: case 9: case 0xa:
  1065. X            return srv.x.dx;
  1066. X        case 2: case 3: case 4: case 5:
  1067. X        case 6: case 7: case 8: case 0xe:
  1068. X            return srv.x.ax;
  1069. X        case 1: case 0xb: case 0xc: case 0xd:
  1070. X        case 0xf:
  1071. X        default:
  1072. X            return 0;
  1073. X        }
  1074. X    }
  1075. X}
  1076. X
  1077. X
  1078. X/*
  1079. X * Sleep function.
  1080. X */
  1081. Xvoid
  1082. Xsleep(unsigned len)
  1083. X{
  1084. X    time_t end;
  1085. X
  1086. X    end = time((time_t *)0) + len;
  1087. X    while (time((time_t *)0) < end)
  1088. X        ;
  1089. X}
  1090. X
  1091. X/*
  1092. X * Just pretend that everyone is a superuser
  1093. X */
  1094. X#define ROOT_UID    0
  1095. X#define ROOT_GID    0
  1096. Xint
  1097. Xgetuid(void)
  1098. X{
  1099. X    return ROOT_UID;
  1100. X}
  1101. X
  1102. Xint
  1103. Xgeteuid(void)
  1104. X{
  1105. X    return ROOT_UID;
  1106. X}
  1107. X
  1108. Xint
  1109. Xgetgid(void)
  1110. X{
  1111. X    return ROOT_GID;
  1112. X}
  1113. X
  1114. Xint
  1115. Xgetegid(void)
  1116. X{
  1117. X    return ROOT_GID;
  1118. X}
  1119. X
  1120. Xint
  1121. Xsetuid(int uid)
  1122. X{ return (uid==ROOT_UID?0:-1); }
  1123. X
  1124. Xint
  1125. Xsetgid(int gid)
  1126. X{ return (gid==ROOT_GID?0:-1); }
  1127. X
  1128. X/*
  1129. X * The following code is based on the do_exec and do_aexec functions
  1130. X * in file doio.c
  1131. X */
  1132. Xint
  1133. Xdo_aspawn(really,arglast)
  1134. XSTR *really;
  1135. Xint *arglast;
  1136. X{
  1137. X    register STR **st = stack->ary_array;
  1138. X    register int sp = arglast[1];
  1139. X    register int items = arglast[2] - sp;
  1140. X    register char **a;
  1141. X    char **argv;
  1142. X    char *tmps;
  1143. X    int status;
  1144. X
  1145. X    if (items) {
  1146. X    New(1101,argv, items+1, char*);
  1147. X    a = argv;
  1148. X    for (st += ++sp; items > 0; items--,st++) {
  1149. X        if (*st)
  1150. X        *a++ = str_get(*st);
  1151. X        else
  1152. X        *a++ = "";
  1153. X    }
  1154. X    *a = Nullch;
  1155. X    if (really && *(tmps = str_get(really)))
  1156. X        status = spawnvp(P_WAIT,tmps,argv);
  1157. X    else
  1158. X        status = spawnvp(P_WAIT,argv[0],argv);
  1159. X    Safefree(argv);
  1160. X    }
  1161. X    return status;
  1162. X}
  1163. X
  1164. X
  1165. Xint
  1166. Xdo_spawn(cmd)
  1167. Xchar *cmd;
  1168. X{
  1169. X    register char **a;
  1170. X    register char *s;
  1171. X    char **argv;
  1172. X    char flags[10];
  1173. X    int status;
  1174. X    char *shell, *cmd2;
  1175. X
  1176. X    /* save an extra exec if possible */
  1177. X    if ((shell = getenv("COMSPEC")) == 0)
  1178. X    shell = "\\command.com";
  1179. X
  1180. X    /* see if there are shell metacharacters in it */
  1181. X    if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|'))
  1182. X      doshell:
  1183. X        return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0);
  1184. X
  1185. X    New(1102,argv, strlen(cmd) / 2 + 2, char*);
  1186. X
  1187. X    New(1103,cmd2, strlen(cmd) + 1, char);
  1188. X    strcpy(cmd2, cmd);
  1189. X    a = argv;
  1190. X    for (s = cmd2; *s;) {
  1191. X    while (*s && isspace(*s)) s++;
  1192. X    if (*s)
  1193. X        *(a++) = s;
  1194. X    while (*s && !isspace(*s)) s++;
  1195. X    if (*s)
  1196. X        *s++ = '\0';
  1197. X    }
  1198. X    *a = Nullch;
  1199. X    if (argv[0])
  1200. X    if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
  1201. X        Safefree(argv);
  1202. X        Safefree(cmd2);
  1203. X        goto doshell;
  1204. X    }
  1205. X    Safefree(cmd2);
  1206. X    Safefree(argv);
  1207. X    return status;
  1208. X}
  1209. !STUFFY!FUNK!
  1210. echo Extracting eg/scan/scan_messages
  1211. sed >eg/scan/scan_messages <<'!STUFFY!FUNK!' -e 's/X//'
  1212. X#!/usr/bin/perl -P
  1213. X
  1214. X# $Header: scan_messages,v 4.0 91/03/20 01:13:01 lwall Locked $
  1215. X
  1216. X# This prints out extraordinary console messages.  You'll need to customize.
  1217. X
  1218. Xchdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
  1219. X
  1220. X$maxpos = `cat oldmsgs 2>&1`;
  1221. X
  1222. X#if defined(mc300) || defined(mc500) || defined(mc700)
  1223. Xopen(Msgs, '/dev/null') || die "scan_messages: can't open messages";
  1224. X#else
  1225. Xopen(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages";
  1226. X#endif
  1227. X
  1228. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1229. X   $blksize,$blocks) = stat(Msgs);
  1230. X
  1231. Xif ($size < $maxpos) {        # Did somebody truncate messages file?
  1232. X    $maxpos = 0;
  1233. X}
  1234. X
  1235. Xseek(Msgs,$maxpos,0);        # Start where we left off last time.
  1236. X
  1237. Xwhile (<Msgs>) {
  1238. X    s/\[(\d+)\]/#/ && s/$1/#/g;
  1239. X#ifdef vax
  1240. X    $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//;
  1241. X    next if /root@.*:/;
  1242. X    next if /^vmunix: 4.3 BSD UNIX/;
  1243. X    next if /^vmunix: Copyright/;
  1244. X    next if /^vmunix: avail mem =/;
  1245. X    next if /^vmunix: SBIA0 at /;
  1246. X    next if /^vmunix: disk ra81 is/;
  1247. X    next if /^vmunix: dmf. at uba/;
  1248. X    next if /^vmunix: dmf.:.*asynch/;
  1249. X    next if /^vmunix: ex. at uba/;
  1250. X    next if /^vmunix: ex.: HW/;
  1251. X    next if /^vmunix: il. at uba/;
  1252. X    next if /^vmunix: il.: hardware/;
  1253. X    next if /^vmunix: ra. at uba/;
  1254. X    next if /^vmunix: ra.: media/;
  1255. X    next if /^vmunix: real mem/;
  1256. X    next if /^vmunix: syncing disks/;
  1257. X    next if /^vmunix: tms/;
  1258. X    next if /^vmunix: tmscp. at uba/;
  1259. X    next if /^vmunix: uba. at /;
  1260. X    next if /^vmunix: uda. at /;
  1261. X    next if /^vmunix: uda.: unit . ONLIN/;
  1262. X    next if /^vmunix: .*buffers containing/;
  1263. X    next if /^syslogd: .*newslog/;
  1264. X#endif
  1265. X    next if /unknown service/;
  1266. X    next if /^\.\.\.$/;
  1267. X    if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) {
  1268. X    $pfx = '';
  1269. X    next;
  1270. X    }
  1271. X    next if /^[ \t]*$/;
  1272. X    next if /^[ 0-9]*done$/;
  1273. X    if (/^A/) {
  1274. X    next if /^Accounting [sr]/;
  1275. X    }
  1276. X    elsif (/^C/) {
  1277. X    next if /^Called from/;
  1278. X    next if /^Copyright/;
  1279. X    }
  1280. X    elsif (/^E/) {
  1281. X    next if /^End traceback/;
  1282. X    next if /^Ethernet address =/;
  1283. X    }
  1284. X    elsif (/^K/) {
  1285. X    next if /^KERNEL MODE/;
  1286. X    }
  1287. X    elsif (/^R/) {
  1288. X    next if /^Rebooting Unix/;
  1289. X    }
  1290. X    elsif (/^S/) {
  1291. X    next if /^Sun UNIX 4\.2 Release/;
  1292. X    }
  1293. X    elsif (/^W/) {
  1294. X    next if /^WARNING: clock gained/;
  1295. X    }
  1296. X    elsif (/^a/) {
  1297. X    next if /^arg /;
  1298. X    next if /^avail mem =/;
  1299. X    }
  1300. X    elsif (/^b/) {
  1301. X    next if /^bwtwo[0-9] at /;
  1302. X    }
  1303. X    elsif (/^c/) {
  1304. X    next if /^cgone[0-9] at /;
  1305. X    next if /^cdp[0-9] at /;
  1306. X    next if /^csr /;
  1307. X    }
  1308. X    elsif (/^d/) {
  1309. X    next if /^dcpa: init/;
  1310. X    next if /^done$/;
  1311. X    next if /^dts/;
  1312. X    next if /^dump i\/o error/;
  1313. X    next if /^dumping to dev/;
  1314. X    next if /^dump succeeded/;
  1315. X    $pfx = '*' if /^dev = /;
  1316. X    }
  1317. X    elsif (/^e/) {
  1318. X    next if /^end \*\*/;
  1319. X    next if /^error in copy/;
  1320. X    }
  1321. X    elsif (/^f/) {
  1322. X    next if /^found /;
  1323. X    }
  1324. X    elsif (/^i/) {
  1325. X    next if /^ib[0-9] at /;
  1326. X    next if /^ie[0-9] at /;
  1327. X    }
  1328. X    elsif (/^l/) {
  1329. X    next if /^le[0-9] at /;
  1330. X    }
  1331. X    elsif (/^m/) {
  1332. X    next if /^mem = /;
  1333. X    next if /^mt[0-9] at /;
  1334. X    next if /^mti[0-9] at /;
  1335. X    $pfx = '*' if /^mode = /;
  1336. X    }
  1337. X    elsif (/^n/) {
  1338. X    next if /^not found /;
  1339. X    }
  1340. X    elsif (/^p/) {
  1341. X    next if /^page map /;
  1342. X    next if /^pi[0-9] at /;
  1343. X    $pfx = '*' if /^panic/;
  1344. X    }
  1345. X    elsif (/^q/) {
  1346. X    next if /^qqq /;
  1347. X    }
  1348. X    elsif (/^r/) {
  1349. X    next if /^read  /;
  1350. X    next if /^revarp: Requesting/;
  1351. X    next if /^root [od]/;
  1352. X    }
  1353. X    elsif (/^s/) {
  1354. X    next if /^sc[0-9] at /;
  1355. X    next if /^sd[0-9] at /;
  1356. X    next if /^sd[0-9]: </;
  1357. X    next if /^si[0-9] at /;
  1358. X    next if /^si_getstatus/;
  1359. X    next if /^sk[0-9] at /;
  1360. X    next if /^skioctl/;
  1361. X    next if /^skopen/;
  1362. X    next if /^skprobe/;
  1363. X    next if /^skread/;
  1364. X    next if /^skwrite/;
  1365. X    next if /^sky[0-9] at /;
  1366. X    next if /^st[0-9] at /;
  1367. X    next if /^st0:.*load/;
  1368. X    next if /^stat1 = /;
  1369. X    next if /^syncing disks/;
  1370. X    next if /^syslogd: going down on signal 15/;
  1371. X    }
  1372. X    elsif (/^t/) {
  1373. X    next if /^timeout [0-9]/;
  1374. X    next if /^tm[0-9] at /;
  1375. X    next if /^tod[0-9] at /;
  1376. X    next if /^tv [0-9]/;
  1377. X    $pfx = '*' if /^trap address/;
  1378. X    }
  1379. X    elsif (/^u/) {
  1380. X    next if /^unit nsk/;
  1381. X    next if /^use one of/;
  1382. X    $pfx = '' if /^using/;
  1383. X    next if /^using [0-9]+ buffers/;
  1384. X    }
  1385. X    elsif (/^x/) {
  1386. X    next if /^xy[0-9] at /;
  1387. X    next if /^write [0-9]/;
  1388. X    next if /^xy[0-9]: </;
  1389. X    next if /^xyc[0-9] at /;
  1390. X    }
  1391. X    elsif (/^y/) {
  1392. X    next if /^yyy [0-9]/;
  1393. X    }
  1394. X    elsif (/^z/) {
  1395. X    next if /^zs[0-9] at /;
  1396. X    }
  1397. X    $pfx = '*' if /^[a-z]+:$/;
  1398. X    s/pid [0-9]+: //;
  1399. X    if (/last message repeated ([0-9]+) time/) {
  1400. X    $seen{$last} += $1;
  1401. X    next;
  1402. X    }
  1403. X    s/^/$pfx/ if $pfx;
  1404. X    unless ($seen{$_}++) {
  1405. X    push(@seen,$_);
  1406. X    }
  1407. X    $last = $_;
  1408. X}
  1409. X$max = tell(Msgs);
  1410. X
  1411. Xopen(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file: $!\n";
  1412. Xwhile ($_ = pop(@seen)) {
  1413. X    print tmp $_;
  1414. X}
  1415. Xclose(tmp);
  1416. Xopen(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n";
  1417. Xwhile (<tmp>) {
  1418. X    if (/^nd:/) {
  1419. X    next if $seen{$_} < 20;
  1420. X    }
  1421. X    if (/NFS/) {
  1422. X    next if $seen{$_} < 20;
  1423. X    }
  1424. X    if (/no carrier/) {
  1425. X    next if $seen{$_} < 20;
  1426. X    }
  1427. X    if (/silo overflow/) {
  1428. X    next if $seen{$_} < 20;
  1429. X    }
  1430. X    print $seen{$_},":\t",$_;
  1431. X}
  1432. X
  1433. Xprint `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`;
  1434. !STUFFY!FUNK!
  1435. echo Extracting x2p/util.c
  1436. sed >x2p/util.c <<'!STUFFY!FUNK!' -e 's/X//'
  1437. X/* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $
  1438. X *
  1439. X *    Copyright (c) 1989, Larry Wall
  1440. X *
  1441. X *    You may distribute under the terms of the GNU General Public License
  1442. X *    as specified in the README file that comes with the perl 3.0 kit.
  1443. X *
  1444. X * $Log:    util.c,v $
  1445. X * Revision 4.0  91/03/20  01:58:25  lwall
  1446. X * 4.0 baseline.
  1447. X * 
  1448. X */
  1449. X
  1450. X#include <stdio.h>
  1451. X
  1452. X#include "handy.h"
  1453. X#include "EXTERN.h"
  1454. X#include "a2p.h"
  1455. X#include "INTERN.h"
  1456. X#include "util.h"
  1457. X
  1458. X#define FLUSH
  1459. X#define MEM_SIZE unsigned int
  1460. X
  1461. Xstatic char nomem[] = "Out of memory!\n";
  1462. X
  1463. X/* paranoid version of malloc */
  1464. X
  1465. Xstatic int an = 0;
  1466. X
  1467. Xchar *
  1468. Xsafemalloc(size)
  1469. XMEM_SIZE size;
  1470. X{
  1471. X    char *ptr;
  1472. X    char *malloc();
  1473. X
  1474. X    ptr = malloc(size?size:1);    /* malloc(0) is NASTY on our system */
  1475. X#ifdef DEBUGGING
  1476. X    if (debug & 128)
  1477. X    fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
  1478. X#endif
  1479. X    if (ptr != Nullch)
  1480. X    return ptr;
  1481. X    else {
  1482. X    fputs(nomem,stdout) FLUSH;
  1483. X    exit(1);
  1484. X    }
  1485. X    /*NOTREACHED*/
  1486. X}
  1487. X
  1488. X/* paranoid version of realloc */
  1489. X
  1490. Xchar *
  1491. Xsaferealloc(where,size)
  1492. Xchar *where;
  1493. XMEM_SIZE size;
  1494. X{
  1495. X    char *ptr;
  1496. X    char *realloc();
  1497. X
  1498. X    ptr = realloc(where,size?size:1);    /* realloc(0) is NASTY on our system */
  1499. X#ifdef DEBUGGING
  1500. X    if (debug & 128) {
  1501. X    fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
  1502. X    fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
  1503. X    }
  1504. X#endif
  1505. X    if (ptr != Nullch)
  1506. X    return ptr;
  1507. X    else {
  1508. X    fputs(nomem,stdout) FLUSH;
  1509. X    exit(1);
  1510. X    }
  1511. X    /*NOTREACHED*/
  1512. X}
  1513. X
  1514. X/* safe version of free */
  1515. X
  1516. Xsafefree(where)
  1517. Xchar *where;
  1518. X{
  1519. X#ifdef DEBUGGING
  1520. X    if (debug & 128)
  1521. X    fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
  1522. X#endif
  1523. X    free(where);
  1524. X}
  1525. X
  1526. X/* safe version of string copy */
  1527. X
  1528. Xchar *
  1529. Xsafecpy(to,from,len)
  1530. Xchar *to;
  1531. Xregister char *from;
  1532. Xregister int len;
  1533. X{
  1534. X    register char *dest = to;
  1535. X
  1536. X    if (from != Nullch) 
  1537. X    for (len--; len && (*dest++ = *from++); len--) ;
  1538. X    *dest = '\0';
  1539. X    return to;
  1540. X}
  1541. X
  1542. X/* copy a string up to some (non-backslashed) delimiter, if any */
  1543. X
  1544. Xchar *
  1545. Xcpytill(to,from,delim)
  1546. Xregister char *to, *from;
  1547. Xregister int delim;
  1548. X{
  1549. X    for (; *from; from++,to++) {
  1550. X    if (*from == '\\') {
  1551. X        if (from[1] == delim)
  1552. X        from++;
  1553. X        else if (from[1] == '\\')
  1554. X        *to++ = *from++;
  1555. X    }
  1556. X    else if (*from == delim)
  1557. X        break;
  1558. X    *to = *from;
  1559. X    }
  1560. X    *to = '\0';
  1561. X    return from;
  1562. X}
  1563. X
  1564. X
  1565. Xchar *
  1566. Xcpy2(to,from,delim)
  1567. Xregister char *to, *from;
  1568. Xregister int delim;
  1569. X{
  1570. X    for (; *from; from++,to++) {
  1571. X    if (*from == '\\')
  1572. X        *to++ = *from++;
  1573. X    else if (*from == '$')
  1574. X        *to++ = '\\';
  1575. X    else if (*from == delim)
  1576. X        break;
  1577. X    *to = *from;
  1578. X    }
  1579. X    *to = '\0';
  1580. X    return from;
  1581. X}
  1582. X
  1583. X/* return ptr to little string in big string, NULL if not found */
  1584. X
  1585. Xchar *
  1586. Xinstr(big, little)
  1587. Xchar *big, *little;
  1588. X
  1589. X{
  1590. X    register char *t, *s, *x;
  1591. X
  1592. X    for (t = big; *t; t++) {
  1593. X    for (x=t,s=little; *s; x++,s++) {
  1594. X        if (!*x)
  1595. X        return Nullch;
  1596. X        if (*s != *x)
  1597. X        break;
  1598. X    }
  1599. X    if (!*s)
  1600. X        return t;
  1601. X    }
  1602. X    return Nullch;
  1603. X}
  1604. X
  1605. X/* copy a string to a safe spot */
  1606. X
  1607. Xchar *
  1608. Xsavestr(str)
  1609. Xchar *str;
  1610. X{
  1611. X    register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
  1612. X
  1613. X    (void)strcpy(newaddr,str);
  1614. X    return newaddr;
  1615. X}
  1616. X
  1617. X/* grow a static string to at least a certain length */
  1618. X
  1619. Xvoid
  1620. Xgrowstr(strptr,curlen,newlen)
  1621. Xchar **strptr;
  1622. Xint *curlen;
  1623. Xint newlen;
  1624. X{
  1625. X    if (newlen > *curlen) {        /* need more room? */
  1626. X    if (*curlen)
  1627. X        *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
  1628. X    else
  1629. X        *strptr = safemalloc((MEM_SIZE)newlen);
  1630. X    *curlen = newlen;
  1631. X    }
  1632. X}
  1633. X
  1634. X/*VARARGS1*/
  1635. Xfatal(pat,a1,a2,a3,a4)
  1636. Xchar *pat;
  1637. X{
  1638. X    fprintf(stderr,pat,a1,a2,a3,a4);
  1639. X    exit(1);
  1640. X}
  1641. X
  1642. X/*VARARGS1*/
  1643. Xwarn(pat,a1,a2,a3,a4)
  1644. Xchar *pat;
  1645. X{
  1646. X    fprintf(stderr,pat,a1,a2,a3,a4);
  1647. X}
  1648. X
  1649. Xstatic bool firstsetenv = TRUE;
  1650. Xextern char **environ;
  1651. X
  1652. Xvoid
  1653. Xsetenv(nam,val)
  1654. Xchar *nam, *val;
  1655. X{
  1656. X    register int i=envix(nam);        /* where does it go? */
  1657. X
  1658. X    if (!environ[i]) {            /* does not exist yet */
  1659. X    if (firstsetenv) {        /* need we copy environment? */
  1660. X        int j;
  1661. X#ifndef lint
  1662. X        char **tmpenv = (char**)    /* point our wand at memory */
  1663. X        safemalloc((i+2) * sizeof(char*));
  1664. X#else
  1665. X        char **tmpenv = Null(char **);
  1666. X#endif /* lint */
  1667. X    
  1668. X        firstsetenv = FALSE;
  1669. X        for (j=0; j<i; j++)        /* copy environment */
  1670. X        tmpenv[j] = environ[j];
  1671. X        environ = tmpenv;        /* tell exec where it is now */
  1672. X    }
  1673. X#ifndef lint
  1674. X    else
  1675. X        environ = (char**) saferealloc((char*) environ,
  1676. X        (i+2) * sizeof(char*));
  1677. X                    /* just expand it a bit */
  1678. X#endif /* lint */
  1679. X    environ[i+1] = Nullch;    /* make sure it's null terminated */
  1680. X    }
  1681. X    environ[i] = safemalloc(strlen(nam) + strlen(val) + 2);
  1682. X                    /* this may or may not be in */
  1683. X                    /* the old environ structure */
  1684. X    sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
  1685. X}
  1686. X
  1687. Xint
  1688. Xenvix(nam)
  1689. Xchar *nam;
  1690. X{
  1691. X    register int i, len = strlen(nam);
  1692. X
  1693. X    for (i = 0; environ[i]; i++) {
  1694. X    if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
  1695. X        break;            /* strnEQ must come first to avoid */
  1696. X    }                    /* potential SEGV's */
  1697. X    return i;
  1698. X}
  1699. !STUFFY!FUNK!
  1700. echo Extracting os2/director.c
  1701. sed >os2/director.c <<'!STUFFY!FUNK!' -e 's/X//'
  1702. X/*
  1703. X * @(#)dir.c 1.4 87/11/06 Public Domain.
  1704. X *
  1705. X *  A public domain implementation of BSD directory routines for
  1706. X *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
  1707. X *  August 1897
  1708. X *  Ported to OS/2 by Kai Uwe Rommel
  1709. X *  December 1989, February 1990
  1710. X *  Change for HPFS support, October 1990
  1711. X */
  1712. X
  1713. X#include <sys/types.h>
  1714. X#include <sys/stat.h>
  1715. X#include <sys/dir.h>
  1716. X
  1717. X#include <stdlib.h>
  1718. X#include <stdio.h>
  1719. X#include <malloc.h>
  1720. X#include <string.h>
  1721. X#include <ctype.h>
  1722. X
  1723. X#define INCL_NOPM
  1724. X#include <os2.h>
  1725. X
  1726. X
  1727. X#ifndef PERLGLOB
  1728. Xint attributes = A_DIR | A_HIDDEN;
  1729. X
  1730. X
  1731. Xstatic char *getdirent(char *);
  1732. Xstatic void free_dircontents(struct _dircontents *);
  1733. X
  1734. Xstatic HDIR hdir;
  1735. Xstatic USHORT count;
  1736. Xstatic FILEFINDBUF find;
  1737. Xstatic BOOL lower;
  1738. X
  1739. X
  1740. XDIR *opendir(char *name)
  1741. X{
  1742. X  struct stat statb;
  1743. X  DIR *dirp;
  1744. X  char c;
  1745. X  char *s;
  1746. X  struct _dircontents *dp;
  1747. X  char nbuf[MAXPATHLEN + 1];
  1748. X
  1749. X  strcpy(nbuf, name);
  1750. X
  1751. X  if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
  1752. X       (strlen(nbuf) > 1) )
  1753. X  {
  1754. X    nbuf[strlen(nbuf) - 1] = 0;
  1755. X
  1756. X    if ( nbuf[strlen(nbuf) - 1] == ':' )
  1757. X      strcat(nbuf, "\\.");
  1758. X  }
  1759. X  else
  1760. X    if ( nbuf[strlen(nbuf) - 1] == ':' )
  1761. X      strcat(nbuf, ".");
  1762. X
  1763. X  if (stat(nbuf, &statb) < 0 || (statb.st_mode & S_IFMT) != S_IFDIR)
  1764. X    return NULL;
  1765. X
  1766. X  if ( (dirp = malloc(sizeof(DIR))) == NULL )
  1767. X    return NULL;
  1768. X
  1769. X  if ( nbuf[strlen(nbuf) - 1] == '.' )
  1770. X    strcpy(nbuf + strlen(nbuf) - 1, "*.*");
  1771. X  else
  1772. X    if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') &&
  1773. X         (strlen(nbuf) == 1) )
  1774. X      strcat(nbuf, "*.*");
  1775. X    else
  1776. X      strcat(nbuf, "\\*.*");
  1777. X
  1778. X  dirp -> dd_loc = 0;
  1779. X  dirp -> dd_contents = dirp -> dd_cp = NULL;
  1780. X
  1781. X  if ((s = getdirent(nbuf)) == NULL)
  1782. X    return dirp;
  1783. X
  1784. X  do
  1785. X  {
  1786. X    if (((dp = malloc(sizeof(struct _dircontents))) == NULL) ||
  1787. X        ((dp -> _d_entry = malloc(strlen(s) + 1)) == NULL)      )
  1788. X    {
  1789. X      if (dp)
  1790. X        free(dp);
  1791. X      free_dircontents(dirp -> dd_contents);
  1792. X
  1793. X      return NULL;
  1794. X    }
  1795. X
  1796. X    if (dirp -> dd_contents)
  1797. X      dirp -> dd_cp = dirp -> dd_cp -> _d_next = dp;
  1798. X    else
  1799. X      dirp -> dd_contents = dirp -> dd_cp = dp;
  1800. X
  1801. X    strcpy(dp -> _d_entry, s);
  1802. X    dp -> _d_next = NULL;
  1803. X
  1804. X    dp -> _d_size = find.cbFile;
  1805. X    dp -> _d_mode = find.attrFile;
  1806. X    dp -> _d_time = *(unsigned *) &(find.ftimeLastWrite);
  1807. X    dp -> _d_date = *(unsigned *) &(find.fdateLastWrite);
  1808. X  }
  1809. X  while ((s = getdirent(NULL)) != NULL);
  1810. X
  1811. X  dirp -> dd_cp = dirp -> dd_contents;
  1812. X
  1813. X  return dirp;
  1814. X}
  1815. X
  1816. X
  1817. Xvoid closedir(DIR * dirp)
  1818. X{
  1819. X  free_dircontents(dirp -> dd_contents);
  1820. X  free(dirp);
  1821. X}
  1822. X
  1823. X
  1824. Xstruct direct *readdir(DIR * dirp)
  1825. X{
  1826. X  static struct direct dp;
  1827. X
  1828. X  if (dirp -> dd_cp == NULL)
  1829. X    return NULL;
  1830. X
  1831. X  dp.d_namlen = dp.d_reclen =
  1832. X    strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
  1833. X
  1834. X  dp.d_ino = 0;
  1835. X
  1836. X  dp.d_size = dirp -> dd_cp -> _d_size;
  1837. X  dp.d_mode = dirp -> dd_cp -> _d_mode;
  1838. X  dp.d_time = dirp -> dd_cp -> _d_time;
  1839. X  dp.d_date = dirp -> dd_cp -> _d_date;
  1840. X
  1841. X  dirp -> dd_cp = dirp -> dd_cp -> _d_next;
  1842. X  dirp -> dd_loc++;
  1843. X
  1844. X  return &dp;
  1845. X}
  1846. X
  1847. X
  1848. Xvoid seekdir(DIR * dirp, long off)
  1849. X{
  1850. X  long i = off;
  1851. X  struct _dircontents *dp;
  1852. X
  1853. X  if (off >= 0)
  1854. X  {
  1855. X    for (dp = dirp -> dd_contents; --i >= 0 && dp; dp = dp -> _d_next);
  1856. X
  1857. X    dirp -> dd_loc = off - (i + 1);
  1858. X    dirp -> dd_cp = dp;
  1859. X  }
  1860. X}
  1861. X
  1862. X
  1863. Xlong telldir(DIR * dirp)
  1864. X{
  1865. X  return dirp -> dd_loc;
  1866. X}
  1867. X
  1868. X
  1869. Xstatic void free_dircontents(struct _dircontents * dp)
  1870. X{
  1871. X  struct _dircontents *odp;
  1872. X
  1873. X  while (dp)
  1874. X  {
  1875. X    if (dp -> _d_entry)
  1876. X      free(dp -> _d_entry);
  1877. X
  1878. X    dp = (odp = dp) -> _d_next;
  1879. X    free(odp);
  1880. X  }
  1881. X}
  1882. X
  1883. X
  1884. Xstatic
  1885. X#endif
  1886. Xint IsFileSystemFAT(char *dir)
  1887. X{
  1888. X  USHORT nDrive;
  1889. X  ULONG lMap;
  1890. X  BYTE bData[64], bName[3];
  1891. X  USHORT cbData;
  1892. X
  1893. X  if ( _osmode == DOS_MODE )
  1894. X    return TRUE;
  1895. X  else
  1896. X  {
  1897. X    /* We separate FAT and HPFS file systems here.
  1898. X     * Filenames read from a FAT system are converted to lower case
  1899. X     * while the case of filenames read from a HPFS (and other future
  1900. X     * file systems, like Unix-compatibles) is preserved.
  1901. X     */
  1902. X
  1903. X    if ( isalpha(dir[0]) && (dir[1] == ':') )
  1904. X      nDrive = toupper(dir[0]) - '@';
  1905. X    else
  1906. X      DosQCurDisk(&nDrive, &lMap);
  1907. X
  1908. X    bName[0] = (char) (nDrive + '@');
  1909. X    bName[1] = ':';
  1910. X    bName[2] = 0;
  1911. X
  1912. X    cbData = sizeof(bData);
  1913. X
  1914. X    if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
  1915. X      return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
  1916. X    else
  1917. X      return FALSE;
  1918. X
  1919. X    /* End of this ugly code */
  1920. X  }
  1921. X}
  1922. X
  1923. X#ifndef PERLGLOB
  1924. Xstatic char *getdirent(char *dir)
  1925. X{
  1926. X  int done;
  1927. X
  1928. X  if (dir != NULL)
  1929. X  {                       /* get first entry */
  1930. X    lower = IsFileSystemFAT(dir);
  1931. X
  1932. X    hdir = HDIR_CREATE;
  1933. X    count = 1;
  1934. X    done = DosFindFirst(dir, &hdir, attributes,
  1935. X            &find, sizeof(find), &count, 0L);
  1936. X  }
  1937. X  else                       /* get next entry */
  1938. X    done = DosFindNext(hdir, &find, sizeof(find), &count);
  1939. X
  1940. X  if ( lower )
  1941. X    strlwr(find.achName);
  1942. X
  1943. X  if (done == 0)
  1944. X    return find.achName;
  1945. X  else
  1946. X  {
  1947. X    DosFindClose(hdir);
  1948. X    return NULL;
  1949. X  }
  1950. X}
  1951. X#endif
  1952. !STUFFY!FUNK!
  1953. echo Extracting makedepend.SH
  1954. sed >makedepend.SH <<'!STUFFY!FUNK!' -e 's/X//'
  1955. Xcase $CONFIG in
  1956. X'')
  1957. X    if test ! -f config.sh; then
  1958. X    ln ../config.sh . || \
  1959. X    ln ../../config.sh . || \
  1960. X    ln ../../../config.sh . || \
  1961. X    (echo "Can't find config.sh."; exit 1)
  1962. X    fi 2>/dev/null
  1963. X    . ./config.sh
  1964. X    ;;
  1965. Xesac
  1966. Xcase "$0" in
  1967. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  1968. Xesac
  1969. Xecho "Extracting makedepend (with variable substitutions)"
  1970. X$spitshell >makedepend <<!GROK!THIS!
  1971. X$startsh
  1972. X# $Header: makedepend.SH,v 4.0 91/03/20 01:27:04 lwall Locked $
  1973. X#
  1974. X# $Log:    makedepend.SH,v $
  1975. X# Revision 4.0  91/03/20  01:27:04  lwall
  1976. X# 4.0 baseline.
  1977. X# 
  1978. X# 
  1979. X
  1980. Xexport PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
  1981. X
  1982. Xcat='$cat'
  1983. Xcppflags='$cppflags'
  1984. Xcp='$cp'
  1985. Xcpp='$cppstdin'
  1986. Xecho='$echo'
  1987. Xegrep='$egrep'
  1988. Xexpr='$expr'
  1989. Xmv='$mv'
  1990. Xrm='$rm'
  1991. Xsed='$sed'
  1992. Xsort='$sort'
  1993. Xtest='$test'
  1994. Xtr='$tr'
  1995. Xuniq='$uniq'
  1996. X!GROK!THIS!
  1997. X
  1998. X$spitshell >>makedepend <<'!NO!SUBS!'
  1999. X
  2000. X$cat /dev/null >.deptmp
  2001. X$rm -f *.c.c c/*.c.c
  2002. Xif test -f Makefile; then
  2003. X    mf=Makefile
  2004. Xelse
  2005. X    mf=makefile
  2006. Xfi
  2007. Xif test -f $mf; then
  2008. X    defrule=`<$mf sed -n        \
  2009. X    -e '/^\.c\.o:.*;/{'        \
  2010. X    -e    's/\$\*\.c//'        \
  2011. X    -e    's/^[^;]*;[     ]*//p'    \
  2012. X    -e    q                \
  2013. X    -e '}'                \
  2014. X    -e '/^\.c\.o: *$/{'        \
  2015. X    -e    N                \
  2016. X    -e    's/\$\*\.c//'        \
  2017. X    -e    's/^.*\n[     ]*//p'        \
  2018. X    -e    q                \
  2019. X    -e '}'`
  2020. Xfi
  2021. Xcase "$defrule" in
  2022. X'') defrule='$(CC) -c $(CFLAGS)' ;;
  2023. Xesac
  2024. X
  2025. Xmake clist || ($echo "Searching for .c files..."; \
  2026. X    $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
  2027. Xfor file in `$cat .clist`; do
  2028. X# for file in `cat /dev/null`; do
  2029. X    case "$file" in
  2030. X    *.c) filebase=`basename $file .c` ;;
  2031. X    *.y) filebase=`basename $file .c` ;;
  2032. X    esac
  2033. X    $echo "Finding dependencies for $filebase.o."
  2034. X    $sed -n <$file >$file.c \
  2035. X    -e "/^${filebase}_init(/q" \
  2036. X    -e '/^#/{' \
  2037. X    -e 's|/\*.*$||' \
  2038. X    -e 's|\\$||' \
  2039. X    -e p \
  2040. X    -e '}'
  2041. X    $cpp -I/usr/local/include -I. $cppflags $file.c | \
  2042. X    $sed \
  2043. X    -e '/^# *[0-9]/!d' \
  2044. X    -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
  2045. X    -e 's|: \./|: |' \
  2046. X    -e 's|\.c\.c|.c|' | \
  2047. X    $uniq | $sort | $uniq >> .deptmp
  2048. Xdone
  2049. X
  2050. X$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
  2051. X
  2052. Xmake shlist || ($echo "Searching for .SH files..."; \
  2053. X    $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
  2054. Xif $test -s .deptmp; then
  2055. X    for file in `cat .shlist`; do
  2056. X    $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
  2057. X        /bin/sh $file >> .deptmp
  2058. X    done
  2059. X    $echo "Updating Makefile..."
  2060. X    $echo "# If this runs make out of memory, delete /usr/include lines." \
  2061. X    >> Makefile.new
  2062. X    $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
  2063. X       >>Makefile.new
  2064. Xelse
  2065. X    make hlist || ($echo "Searching for .h files..."; \
  2066. X    $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
  2067. X    $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
  2068. X    $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
  2069. X    $echo "Updating Makefile..."
  2070. X    <.clist $sed -n                            \
  2071. X    -e '/\//{'                            \
  2072. X    -e   's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p"    \
  2073. X    -e   d                                \
  2074. X    -e '}'                                \
  2075. X    -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
  2076. X    <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
  2077. X    <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
  2078. X       $sed 's|^[^;]*/||' | \
  2079. X       $sed -f .hsed >> Makefile.new
  2080. X    <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
  2081. X       >> Makefile.new
  2082. X    <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
  2083. X       $sed -f .hsed >> Makefile.new
  2084. X    <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
  2085. X       >> Makefile.new
  2086. X    for file in `$cat .shlist`; do
  2087. X    $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
  2088. X        /bin/sh $file >> Makefile.new
  2089. X    done
  2090. Xfi
  2091. X$rm -f Makefile.old
  2092. X$cp Makefile Makefile.old
  2093. X$cp Makefile.new Makefile
  2094. X$rm Makefile.new
  2095. X$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
  2096. X$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
  2097. X
  2098. X!NO!SUBS!
  2099. X$eunicefix makedepend
  2100. Xchmod +x makedepend
  2101. Xcase `pwd` in
  2102. X*SH)
  2103. X    $rm -f ../makedepend
  2104. X    ln makedepend ../makedepend
  2105. X    ;;
  2106. Xesac
  2107. !STUFFY!FUNK!
  2108. echo " "
  2109. echo "End of kit 30 (of 36)"
  2110. cat /dev/null >kit30isdone
  2111. run=''
  2112. config=''
  2113. 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
  2114.     if test -f kit${iskit}isdone; then
  2115.     run="$run $iskit"
  2116.     else
  2117.     todo="$todo $iskit"
  2118.     fi
  2119. done
  2120. case $todo in
  2121.     '')
  2122.     echo "You have run all your kits.  Please read README and then type Configure."
  2123.     for combo in *:AA; do
  2124.         if test -f "$combo"; then
  2125.         realfile=`basename $combo :AA`
  2126.         cat $realfile:[A-Z][A-Z] >$realfile
  2127.         rm -rf $realfile:[A-Z][A-Z]
  2128.         fi
  2129.     done
  2130.     rm -rf kit*isdone
  2131.     chmod 755 Configure
  2132.     ;;
  2133.     *)  echo "You have run$run."
  2134.     echo "You still need to run$todo."
  2135.     ;;
  2136. esac
  2137. : Someone might mail this, so...
  2138. exit
  2139.  
  2140. exit 0 # Just in case...
  2141. -- 
  2142. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  2143. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  2144. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  2145. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  2146.