Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume26/archie/part01

Text File | 1991-11-23 | 53.8 KB | 2,250 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Brendan Kehoe)
Subject:  v26i046:  archie - A Prospero client for Archie, v1.2, Part01/05
Message-ID: <csm-v26i046=[e-mail]>
X-Md4-Signature: d74fd4bb34930ed88f5866ee64664f9d
Date: Sun, 24 Nov 1991 04:53:48 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Brendan Kehoe)
Posting-number: Volume 26, Issue 46
Archive-name: archie/part01
Environment: UNIX, VMS
Supersedes: archie: Volume 22, Issue 35-39

This is the official release of Archie 1.2, a stand-alone client to
access the Archie FTP database.  It's intended to help reduce the
interactive use of the archie server by providing a comfortable,
accessible, and faster method of query.

 Changes since version 1.1 include:

    * much more portable; now runs under VMS (with Multinet & Wallongong
      TCP/IP), MSDOS and OS/2 (with PC/TCP), and countless versions of Unix
    * faster and cleaner code (those in the US will notice a marked
      difference in response time by using the default of ARCHIE.SURA.NET
      for their server; 1.1 used quiche)
    * dirsend.c totally rewritten by George Ferguson
    * bug fixes
    * (hopefully) clearer man page
    * handles Prospero warnings
    * builds with gcc on sparcs properly
    * mentions available servers

 There are now a goodly number of servers available, so no one system
will get hit with the world's use.  They are (as of 11/20/91):

        archie.sura.net (USA, Mexico, etc)
        archie.mcgill.ca (Canada)
        archie.funet.fi (Finland/Mainland Europe)
        archie.au (Australia/New Zealand)
        archie.doc.ic.ac.uk (Great Britain/Ireland)

 The package is available in the comp.sources.misc and vmsnet.sources
newsgroups (and, later, their archives), or via anonymous FTP from:

    * ftp.cs.widener.edu [147.31.254.132] as pub/archie.tar.Z (unix)
      or archie-vms.com (VMS DCL .com file)
    * cs.rochester.edu [192.5.53.209] as pub/archie-1.2.tar.Z
    * ftp.huji.ac.il [132.65.6.5] as pub/archie-clients/c-archie.tar.Z
      (for Israeli sites mainly)

 Please report any comments, suggestions, fixes, (whether positive or negative)
to [e-mail].  Enjoy!

Brendan Kehoe, Widener University, Chester, PA
--
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# Contents:  . ./regex.c ./vms ./vms_support.c
# Wrapped by kent@sparky on Wed Nov 20 18:23:43 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 1 (of 5)."'
if test -f './regex.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'./regex.c'\"
else
  echo shar: Extracting \"'./regex.c'\" \(16057 characters\)
  sed "s/^X//" >'./regex.c' <<'END_OF_FILE'
X#include <pmachine.h>
X
X#ifdef NOREGEX
X/*
X * These routines are BSD regex(3)/ed(1) compatible regular-expression
X * routines written by Ozan S. Yigit, Computer Science, York University.
X * Parts of the code that are not needed by Prospero have been removed,
X * but most of the accompanying information has been left intact.
X * This file is to be included on those operating systems that do not
X * support re_comp and re_exec.
X */
X
X/*
X * regex - Regular expression pattern matching
X *         and replacement
X *
X * by:  Ozan S. Yigit ([e-mail])
X *    Dept. of Computing Services
X *      York University
X *
X * These routines are the PUBLIC DOMAIN equivalents
X * of regex routines as found in 4.nBSD UN*X, with minor
X * extensions.
X *
X * Modification history:
X *
X * $Log:    regex.c,v $
X * Revision 1.3  89/04/01  14:18:09  oz
X * Change all references to a dfa: this is actually an nfa.
X *
X * Revision 1.2  88/08/28  15:36:04  oz
X * Use a complement bitmap to represent NCL.
X * This removes the need to have seperate
X * code in the pmatch case block - it is
X * just CCL code now.
X *
X * Use the actual CCL code in the CLO
X * section of pmatch. No need for a recursive
X * pmatch call.
X *
X * Use a bitmap table to set char bits in an
X * 8-bit chunk.
X *
X * Routines:
X *      re_comp:        compile a regular expression into
X *                      a NFA.
X *
X *            char *re_comp(s)
X *            char *s;
X *
X *      re_exec:        execute the NFA to match a pattern.
X *
X *            int re_exec(s)
X *            char *s;
X *
X * Regular Expressions:
X *
X *      [1]     char    matches itself, unless it is a special
X *                      character (metachar): . \ [ ] * + ^ $
X *
X *      [2]     .       matches any character.
X *
X *      [3]     \       matches the character following it, except
X *            when followed by a left or right round bracket,
X *            a digit 1 to 9 or a left or right angle bracket.
X *            (see [7], [8] and [9])
X *            It is used as an escape character for all
X *            other meta-characters, and itself. When used
X *            in a set ([4]), it is treated as an ordinary
X *            character.
X *
X *      [4]     [set]   matches one of the characters in the set.
X *                      If the first character in the set is "^",
X *                      it matches a character NOT in the set, i.e.
X *            complements the set. A shorthand S-E is
X *            used to specify a set of characters S upto
X *            E, inclusive. The special characters "]" and
X *            "-" have no special meaning if they appear
X *            as the first chars in the set.
X *                      examples:        match:
X *
X *                              [a-z]    any lowercase alpha
X *
X *                              [^]-]    any char except ] and -
X *
X *                              [^A-Z]   any char except uppercase
X *                                       alpha
X *
X *                              [a-zA-Z] any alpha
X *
X *      [5]     *       any regular expression form [1] to [4], followed by
X *                      closure char (*) matches zero or more matches of
X *                      that form.
X *
X *      [6]     +       same as [5], except it matches one or more.
X *
X *      [7]             a regular expression in the form [1] to [10], enclosed
X *                      as \(form\) matches what form matches. The enclosure
X *                      creates a set of tags, used for [8] and for
X *                      pattern substution. The tagged forms are numbered
X *            starting from 1.
X *
X *      [8]             a \ followed by a digit 1 to 9 matches whatever a
X *                      previously tagged regular expression ([7]) matched.
X *
X *    [9]    \<    a regular expression starting with a \< construct
X *        \>    and/or ending with a \> construct, restricts the
X *            pattern matching to the beginning of a word, and/or
X *            the end of a word. A word is defined to be a character
X *            string beginning and/or ending with the characters
X *            A-Z a-z 0-9 and _. It must also be preceded and/or
X *            followed by any character outside those mentioned.
X *
X *      [10]            a composite regular expression xy where x and y
X *                      are in the form [1] to [10] matches the longest
X *                      match of x followed by a match for y.
X *
X *      [11]    ^    a regular expression starting with a ^ character
X *        $    and/or ending with a $ character, restricts the
X *                      pattern matching to the beginning of the line,
X *                      or the end of line. [anchors] Elsewhere in the
X *            pattern, ^ and $ are treated as ordinary characters.
X *
X *
X * Acknowledgements:
X *
X *    HCR's Hugh Redelmeier has been most helpful in various
X *    stages of development. He convinced me to include BOW
X *    and EOW constructs, originally invented by Rob Pike at
X *    the University of Toronto.
X *
X * References:
X *              Software tools            Kernighan & Plauger
X *              Software tools in Pascal        Kernighan & Plauger
X *              Grep [rsx-11 C dist]            David Conroy
X *        ed - text editor        Un*x Programmer's Manual
X *        Advanced editing on Un*x    B. W. Kernighan
X *        regexp routines            Henry Spencer
X *
X * Notes:
X *
X *    This implementation uses a bit-set representation for character
X *    classes for speed and compactness. Each character is represented
X *    by one bit in a 128-bit block. Thus, CCL always takes a
X *    constant 16 bytes in the internal nfa, and re_exec does a single
X *    bit comparison to locate the character in the set.
X *
X * Examples:
X *
X *    pattern:    foo*.*
X *    compile:    CHR f CHR o CLO CHR o END CLO ANY END END
X *    matches:    fo foo fooo foobar fobar foxx ...
X *
X *    pattern:    fo[ob]a[rz]
X *    compile:    CHR f CHR o CCL bitset CHR a CCL bitset END
X *    matches:    fobar fooar fobaz fooaz
X *
X *    pattern:    foo\\+
X *    compile:    CHR f CHR o CHR o CHR \ CLO CHR \ END END
X *    matches:    foo\ foo\\ foo\\\  ...
X *
X *    pattern:    \(foo\)[1-3]\1    (same as foo[1-3]foo)
X *    compile:    BOT 1 CHR f CHR o CHR o EOT 1 CCL bitset REF 1 END
X *    matches:    foo1foo foo2foo foo3foo
X *
X *    pattern:    \(fo.*\)-\1
X *    compile:    BOT 1 CHR f CHR o CLO ANY END EOT 1 CHR - REF 1 END
X *    matches:    foo-foo fo-fo fob-fob foobar-foobar ...
X *
X */
X
X#define MAXNFA  1024
X#define MAXTAG  10
X
X#define OKP     1
X#define NOP     0
X
X#define CHR     1
X#define ANY     2
X#define CCL     3
X#define BOL     4
X#define EOL     5
X#define BOT     6
X#define EOT     7
X#define BOW    8
X#define EOW    9
X#define REF     10
X#define CLO     11
X
X#define END     0
X
X/*
X * The following defines are not meant
X * to be changeable. They are for readability
X * only.
X *
X */
X#define MAXCHR    128
X#define CHRBIT    8
X#define BITBLK    MAXCHR/CHRBIT
X#define BLKIND    0170
X#define BITIND    07
X
X#define ASCIIB    0177
X
Xtypedef /*unsigned*/ char CHAR;
X
Xstatic int  tagstk[MAXTAG];             /* subpat tag stack..*/
Xstatic CHAR nfa[MAXNFA];        /* automaton..       */
Xstatic int  sta = NOP;                   /* status of lastpat */
X
Xstatic CHAR bittab[BITBLK];        /* bit table for CCL */
X                    /* pre-set bits...   */
Xstatic CHAR bitarr[] = {1,2,4,8,16,32,64,128};
X
Xstatic int internal_error;
X
Xstatic void
Xchset(c)
Xregister CHAR c;
X{
X    bittab[((c) & BLKIND) >> 3] |= bitarr[(c) & BITIND];
X}
X
X#define badpat(x)    return (*nfa = END, x)
X#define store(x)    *mp++ = x
X
Xchar *
Xre_comp(pat)
Xchar *pat;
X{
X    register char *p;               /* pattern pointer   */
X    register CHAR *mp = nfa;        /* nfa pointer       */
X    register CHAR *lp;              /* saved pointer..   */
X    register CHAR *sp = nfa;        /* another one..     */
X
X    register int tagi = 0;          /* tag stack index   */
X    register int tagc = 1;          /* actual tag count  */
X
X    register int n;
X    register CHAR mask;        /* xor mask -CCL/NCL */
X    int c1, c2;
X
X    if (!pat || !*pat)
X        if (sta)
X            return 0;
X        else
X            badpat("No previous regular expression");
X    sta = NOP;
X
X    for (p = pat; *p; p++) {
X        lp = mp;
X        switch(*p) {
X
X        case '.':               /* match any char..  */
X            store(ANY);
X            break;
X
X        case '^':               /* match beginning.. */
X            if (p == pat)
X                store(BOL);
X            else {
X                store(CHR);
X                store(*p);
X            }
X            break;
X
X        case '$':               /* match endofline.. */
X            if (!*(p+1))
X                store(EOL);
X            else {
X                store(CHR);
X                store(*p);
X            }
X            break;
X
X        case '[':               /* match char class..*/
X            store(CCL);
X
X            if (*++p == '^') {
X                mask = 0377;
X                p++;
X            }
X            else
X                mask = 0;
X
X            if (*p == '-')        /* real dash */
X                chset(*p++);
X            if (*p == ']')        /* real brac */
X                chset(*p++);
X            while (*p && *p != ']') {
X                if (*p == '-' && *(p+1) && *(p+1) != ']') {
X                    p++;
X                    c1 = *(p-2) + 1;
X                    c2 = *p++;
X                    while (c1 <= c2)
X                        chset(c1++);
X                }
X#ifdef EXTEND
X                else if (*p == '\\' && *(p+1)) {
X                    p++;
X                    chset(*p++);
X                }
X#endif
X                else
X                    chset(*p++);
X            }
X            if (!*p)
X                badpat("Missing ]");
X
X            for (n = 0; n < BITBLK; bittab[n++] = (char) 0)
X                store(mask ^ bittab[n]);
X
X            break;
X
X        case '*':               /* match 0 or more.. */
X        case '+':               /* match 1 or more.. */
X            if (p == pat)
X                badpat("Empty closure");
X            lp = sp;        /* previous opcode */
X            if (*lp == CLO)        /* equivalence..   */
X                break;
X            switch(*lp) {
X
X            case BOL:
X            case BOT:
X            case EOT:
X            case BOW:
X            case EOW:
X            case REF:
X                badpat("Illegal closure");
X            default:
X                break;
X            }
X
X            if (*p == '+')
X                for (sp = mp; lp < sp; lp++)
X                    store(*lp);
X
X            store(END);
X            store(END);
X            sp = mp;
X            while (--mp > lp)
X                *mp = mp[-1];
X            store(CLO);
X            mp = sp;
X            break;
X
X        case '\\':              /* tags, backrefs .. */
X            switch(*++p) {
X
X            case '(':
X                if (tagc < MAXTAG) {
X                    tagstk[++tagi] = tagc;
X                    store(BOT);
X                    store(tagc++);
X                }
X                else
X                    badpat("Too many \\(\\) pairs");
X                break;
X            case ')':
X                if (*sp == BOT)
X                    badpat("Null pattern inside \\(\\)");
X                if (tagi > 0) {
X                    store(EOT);
X                    store(tagstk[tagi--]);
X                }
X                else
X                    badpat("Unmatched \\)");
X                break;
X            case '<':
X                store(BOW);
X                break;
X            case '>':
X                if (*sp == BOW)
X                    badpat("Null pattern inside \\<\\>");
X                store(EOW);
X                break;
X            case '1':
X            case '2':
X            case '3':
X            case '4':
X            case '5':
X            case '6':
X            case '7':
X            case '8':
X            case '9':
X                n = *p-'0';
X                if (tagi > 0 && tagstk[tagi] == n)
X                    badpat("Cyclical reference");
X                if (tagc > n) {
X                    store(REF);
X                    store(n);
X                }
X                else
X                    badpat("Undetermined reference");
X                break;
X#ifdef EXTEND
X            case 'b':
X                store(CHR);
X                store('\b');
X                break;
X            case 'n':
X                store(CHR);
X                store('\n');
X                break;
X            case 'f':
X                store(CHR);
X                store('\f');
X                break;
X            case 'r':
X                store(CHR);
X                store('\r');
X                break;
X            case 't':
X                store(CHR);
X                store('\t');
X                break;
X#endif
X            default:
X                store(CHR);
X                store(*p);
X            }
X            break;
X
X        default :               /* an ordinary char  */
X            store(CHR);
X            store(*p);
X            break;
X        }
X        sp = lp;
X    }
X    if (tagi > 0)
X        badpat("Unmatched \\(");
X    store(END);
X    sta = OKP;
X    return 0;
X}
X
X
Xstatic char *bol;
Xstatic char *bopat[MAXTAG];
Xstatic char *eopat[MAXTAG];
Xchar *pmatch();
X
X/*
X * re_exec:
X *     execute nfa to find a match.
X *
X *    special cases: (nfa[0])
X *        BOL
X *            Match only once, starting from the
X *            beginning.
X *        CHR
X *            First locate the character without
X *            calling pmatch, and if found, call
X *            pmatch for the remaining string.
X *        END
X *            re_comp failed, poor luser did not
X *            check for it. Fail fast.
X *
X *    If a match is found, bopat[0] and eopat[0] are set
X *    to the beginning and the end of the matched fragment,
X *    respectively.
X *
X */
X
Xint
Xre_exec(lp)
Xregister char *lp;
X{
X    register char c;
X    register char *ep = 0;
X    register CHAR *ap = nfa;
X
X    bol = lp;
X
X    bopat[0] = 0;
X    bopat[1] = 0;
X    bopat[2] = 0;
X    bopat[3] = 0;
X    bopat[4] = 0;
X    bopat[5] = 0;
X    bopat[6] = 0;
X    bopat[7] = 0;
X    bopat[8] = 0;
X    bopat[9] = 0;
X
X    switch(*ap) {
X
X    case BOL:            /* anchored: match from BOL only */
X        ep = pmatch(lp,ap);
X        break;
X    case CHR:            /* ordinary char: locate it fast */
X        c = *(ap+1);
X        while (*lp && *lp != c)
X            lp++;
X        if (!*lp)        /* if EOS, fail, else fall thru. */
X            return 0;
X    default:            /* regular matching all the way. */
X        while (*lp) {
X            if ((ep = pmatch(lp,ap)))
X                break;
X            lp++;
X        }
X        break;
X    case END:            /* munged automaton. fail always */
X        return 0;
X    }
X    if (!ep)
X        return 0;
X
X    if (internal_error)
X        return -1;
X
X    bopat[0] = lp;
X    eopat[0] = ep;
X    return 1;
X}
X
X/*
X * pmatch:
X *    internal routine for the hard part
X *
X *     This code is mostly snarfed from an early
X *     grep written by David Conroy. The backref and
X *     tag stuff, and various other mods are by oZ.
X *
X *    special cases: (nfa[n], nfa[n+1])
X *        CLO ANY
X *            We KNOW ".*" will match ANYTHING
X *            upto the end of line. Thus, go to
X *            the end of line straight, without
X *            calling pmatch recursively. As in
X *            the other closure cases, the remaining
X *            pattern must be matched by moving
X *            backwards on the string recursively,
X *            to find a match for xy (x is ".*" and
X *            y is the remaining pattern) where
X *            the match satisfies the LONGEST match
X *            for x followed by a match for y.
X *        CLO CHR
X *            We can again scan the string forward
X *            for the single char without recursion,
X *            and at the point of failure, we execute
X *            the remaining nfa recursively, as
X *            described above.
X *
X *    At the end of a successful match, bopat[n] and eopat[n]
X *    are set to the beginning and end of subpatterns matched
X *    by tagged expressions (n = 1 to 9).
X *
X */
X
X/*
X * character classification table for word boundary
X * operators BOW and EOW. the reason for not using
X * ctype macros is that we can let the user add into
X * our own table. see re_modw. This table is not in
X * the bitset form, since we may wish to extend it
X * in the future for other character classifications.
X *
X *    TRUE for 0-9 A-Z a-z _
X */
Xstatic char chrtyp[MAXCHR] = {
X    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
X    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
X    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
X    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
X    0, 0, 0, 0, 0, 0, 0, 0, 1, 1,
X    1, 1, 1, 1, 1, 1, 1, 1, 0, 0,
X    0, 0, 0, 0, 0, 1, 1, 1, 1, 1,
X    1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
X    1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
X    1, 0, 0, 0, 0, 1, 0, 1, 1, 1,
X    1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
X    1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
X    1, 1, 1, 0, 0, 0, 0, 0
X    };
X
X#define inascii(x)    (0177&(x))
X#define iswordc(x)     chrtyp[inascii(x)]
X#define isinset(x,y)     ((x)[((y)&BLKIND)>>3] & bitarr[(y)&BITIND])
X
X/*
X * skip values for CLO XXX to skip past the closure
X *
X */
X
X#define ANYSKIP    2     /* [CLO] ANY END ...         */
X#define CHRSKIP    3    /* [CLO] CHR chr END ...     */
X#define CCLSKIP 18    /* [CLO] CCL 16bytes END ... */
X
Xstatic char *
Xpmatch(lp, ap)
Xregister char *lp;
Xregister CHAR *ap;
X{
X    register int op, c, n;
X    register char *e;        /* extra pointer for CLO */
X    register char *bp;        /* beginning of subpat.. */
X    register char *ep;        /* ending of subpat..     */
X    char *are;            /* to save the line ptr. */
X
X    while ((op = *ap++) != END)
X        switch(op) {
X
X        case CHR:
X            if (*lp++ != *ap++)
X                return 0;
X            break;
X        case ANY:
X            if (!*lp++)
X                return 0;
X            break;
X        case CCL:
X            c = *lp++;
X            if (!isinset(ap,c))
X                return 0;
X            ap += BITBLK;
X            break;
X        case BOL:
X            if (lp != bol)
X                return 0;
X            break;
X        case EOL:
X            if (*lp)
X                return 0;
X            break;
X        case BOT:
X            bopat[*ap++] = lp;
X            break;
X        case EOT:
X            eopat[*ap++] = lp;
X            break;
X         case BOW:
X            if (lp!=bol && iswordc(lp[-1]) || !iswordc(*lp))
X                return 0;
X            break;
X        case EOW:
X            if (lp==bol || !iswordc(lp[-1]) || iswordc(*lp))
X                return 0;
X            break;
X        case REF:
X            n = *ap++;
X            bp = bopat[n];
X            ep = eopat[n];
X            while (bp < ep)
X                if (*bp++ != *lp++)
X                    return 0;
X            break;
X        case CLO:
X            are = lp;
X            switch(*ap) {
X
X            case ANY:
X                while (*lp)
X                    lp++;
X                n = ANYSKIP;
X                break;
X            case CHR:
X                c = *(ap+1);
X                while (*lp && c == *lp)
X                    lp++;
X                n = CHRSKIP;
X                break;
X            case CCL:
X                while ((c = *lp) && isinset(ap+1,c))
X                    lp++;
X                n = CCLSKIP;
X                break;
X            default:
X                internal_error++;
X                return 0;
X            }
X
X            ap += n;
X
X            while (lp >= are) {
X                if (e = pmatch(lp, ap))
X                    return e;
X                --lp;
X            }
X            return 0;
X        default:
X            internal_error++;
X            return 0;
X        }
X    return lp;
X}
X#endif /* Need regex libraries? Compile to nothing if not.  */
END_OF_FILE
  if test 16057 -ne `wc -c <'./regex.c'`; then
    echo shar: \"'./regex.c'\" unpacked with wrong size!
  fi
  # end of './regex.c'
fi
if test ! -d './vms' ; then
    echo shar: Creating directory \"'./vms'\"
    mkdir './vms'
fi
if test -f './vms_support.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'./vms_support.c'\"
else
  echo shar: Extracting \"'./vms_support.c'\" \(32780 characters\)
  sed "s/^X//" >'./vms_support.c' <<'END_OF_FILE'
X/* Emulation of 4.2 UNIX socket interface routines includes drivers for
X   Wollongong, CMU-TEK, UCX tcp/ip interface and also emulates the SUN
X   version of X.25 sockets.  The TWG will also work for MultiNet.  */
X
X/* This is from unixlib, by [e-mail]; wonderful implementation.
X   You can get the real thing on 130.123.1.4 as unixlib_tar.z.  */
X
X#include <stdio.h>
X#include <errno.h>
X#include <ssdef.h>
X#include <dvidef.h>
X#include <signal.h>
X#include <sys$library:msgdef.h>
X#include <iodef.h>
X#include <ctype.h>
X#include <vms.h>
X#include "[.vms]network.h"
X
X#define QIO_FAILED (st != SS$_NORMAL || p[s].iosb[0] != SS$_NORMAL)
X#define QIO_ST_FAILED (st != SS$_NORMAL)
X
X/* Socket routine.  */
Xint
XVMSsocket (domain, type, protocol)
X     int domain, type, protocol;
X{
X  struct descriptor inetdesc, x25desc, mbxdesc;
X  int i, st, s, p_initialise ();
X  long ucx_sock_def;
X  char *getenv ();
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p_initialised == 0)
X    {
X      for (i = 0; i < 32; i++)
X    p_initialise (i);
X
X      p_initialised = 1;
X    }
X
X  /* First of all, get a file descriptor and file ptr we can associate with
X     the socket, allocate a buffer, and remember the socket details.  */
X  s = dup (0);
X  if (s > 31)
X    {
X      errno = EMFILE;
X      close (s);
X      return -1;
X    }
X
X  p[s].fptr = fdopen (s, "r");
X  p[s].fd_buff = (unsigned char *) malloc (BUF_SIZE);
X  p[s].domain = domain;
X  p[s].type = type;
X  p[s].protocol = protocol;
X
X  /* Handle the case of INET and X.25 separately.  */
X  if (domain == AF_INET)
X    {
X      if (tcp_make == NONE)
X    {
X      printf ("Trying to obtain a TCP socket when we don't have TCP!\n");
X      exit (1);
X    }
X      if (tcp_make == CMU)
X    {
X      /* For CMU we need only assign a channel.  */
X      inetdesc.size = 3;
X      inetdesc.ptr = "IP:";
X      if (sys$assign (&inetdesc, &p[s].channel, 0, 0) != SS$_NORMAL)
X        return -1;
X    }
X      else if (tcp_make == UCX)
X    {
X      /* For UCX assign channel and associate a socket with it.  */
X      inetdesc.size = 3;
X      inetdesc.ptr = "BG:";
X      if (sys$assign (&inetdesc, &p[s].channel, 0, 0) != SS$_NORMAL)
X        return -1;
X
X      ucx_sock_def = (domain << 24) + (type << 16) + protocol;
X      st = sys$qiow (0, p[s].channel, IO$_SETMODE, p[s].iosb, 0, 0,
X             &ucx_sock_def, 0, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X    }
X      else
X    {
X      /* For TWG we assign the channel and associate a socket with it.  */
X      inetdesc.size = 7;
X      inetdesc.ptr = "_INET0:";
X
X      if (sys$assign (&inetdesc, &p[s].channel, 0, 0) != SS$_NORMAL)
X        return -1;
X
X      st = sys$qiow (0, p[s].channel, IO$_SOCKET, p[s].iosb, 0, 0,
X             domain, type, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X    }
X    }
X  else
X    /* We don't handle any other domains yet.  */
X    return -1;
X
X  /* For each case if we are successful we return the descriptor.  */
X  return s;
X}
X
X/* Bind routine.  */
XVMSbind (s, name, namelen)
X     int s;
X     union socket_addr *name;
X     int namelen;
X{
X  char infobuff[1024], lhost[32];
X  int st;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p[s].domain == AF_INET)
X    {
X      /* One main problem with bind is that if we're given a port number
X     of 0, then we're expected to return a unique port number.  Since
X     we don't KNOW, we return 1050+s and look to Lady Luck.  */
X      if (tcp_make == CMU)
X    {
X      if (name->in.sin_port == 0 && p[s].type != SOCK_DGRAM)
X        name->in.sin_port = 1050 + s;
X      p[s].namelen = namelen;
X      bcopy (name, &(p[s].name), namelen);
X
X      if (p[s].type == SOCK_DGRAM)
X        {
X          /* Another problem is that CMU still needs an OPEN request
X         even if it's a datagram socket.  */
X          st = sys$qiow (0, p[s].channel, TCP$OPEN, p[s].iosb,
X                 0, 0, 0, 0, ntohs (p[s].name.in.sin_port),
X                 0, 1, 0);
X          if (QIO_ST_FAILED)
X        return -1;
X
X          p[s].cmu_open = 1;
X          sys$qiow (0, p[s].channel, TCP$INFO, p[s].iosb,
X            0, 0, &infobuff, 1024, 0, 0, 0, 0);
X          bcopy (infobuff + 264, &(p[s].name.in.sin_port), 2);
X          p[s].name.in.sin_port = htons (p[s].name.in.sin_port);
X
X          /* So get it another way.  */
X          bcopy (infobuff + 136, lhost, infobuff[1]);
X          lhost[infobuff[1]] = '\0';
X          sys$qiow (0, p[s].channel, GTHST, p[s].iosb,
X            0, 0, &infobuff, 1024, 1, lhost, 0, 0);
X          bcopy (infobuff + 4, &(p[s].name.in.sin_addr), 4);
X
X          /* Be prepared to receive a message.  */
X          hang_a_read (s);
X        }
X    }
X      else if (tcp_make == UCX)
X    {
X      /* UCX will select a prot for you.  If the port's number is 0,
X         translate "name" into an item_2 list.  */
X      struct itemlist lhost;
X      lhost.length = namelen;
X      lhost.code = 0;
X      lhost.dataptr = (char *) name;
X
X      st = sys$qiow (0, p[s].channel, IO$_SETMODE, p[s].iosb, 0, 0,
X             0, 0, &lhost, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      if (p[s].type == SOCK_DGRAM)
X        hang_a_read (s);
X
X    }
X      else
X    {
X      /* WG is more straightforward */
X      st = sys$qiow (0, p[s].channel, IO$_BIND, p[s].iosb,
X             0, 0, name, namelen, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      /* If it's a datagram, get ready for the message.  */
X      if (p[s].type == SOCK_DGRAM)
X        hang_a_read (s);
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X
X  return 0;
X}
X
X/* Connect routine.  */
XVMSconnect (s, name, namelen)
X     int s;
X     union socket_addr *name;
X     int namelen;
X{
X  int pr, fl, st;
X  char *inet_ntoa ();
X  static struct
X  {
X    int len;
X    char name[128];
X  } gethostbuf;
X  extern int connect_ast ();
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  /* For datagrams we need to remember who the name was so we can send all
X     messages to that address without having to specify it all the time.  */
X  if (p[s].connected)
X    {
X      if (p[s].connected == 1)
X    errno = EISCONN;
X      else
X    {
X      errno = ECONNREFUSED;
X      p[s].connected = 0;
X    }
X      return -1;
X    }
X
X  if (p[s].connect_pending)
X    {
X      errno = EALREADY;
X      return -1;
X    }
X
X  p[s].passive = 0;
X  p[s].tolen = namelen;
X  bcopy (name, &(p[s].to), namelen);
X
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X
X      /* Get the info about the remote host  and open up a connection.  */
X      st = sys$qiow (0, p[s].channel, GTHST, p[s].iosb, 0, 0, &gethostbuf,
X             132, 2, name->in.sin_addr.s_addr, 0, 0);
X      if (QIO_FAILED)
X        {
X          strcpy (gethostbuf.name, inet_ntoa (name->in.sin_addr.s_addr));
X          gethostbuf.len = strlen (gethostbuf.name);
X        }
X      gethostbuf.name[gethostbuf.len] = 0;
X
X      /* TCP */
X      pr = 0;
X      /* Active */
X      fl = 1;
X
X      /* Nothing else for datagrams.  */
X      if (p[s].type == SOCK_DGRAM)
X        return (0);
X      st = sys$qio (s, p[s].channel, TCP$OPEN, p[s].iosb, connect_ast,
X            &p[s], &(gethostbuf.name), ntohs (name->in.sin_port),
X            ntohs (p[s].name.in.sin_port), fl, pr, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else if (tcp_make == UCX)
X    {
X      /* Both UDP and TCP can use a connect - IO$_ACCESS */
X      p[s].rhost.length = namelen;
X      p[s].rhost.code = 0;
X      p[s].rhost.dataptr = (char *) name;
X
X      st = sys$qio (s, p[s].channel, IO$_ACCESS, p[s].iosb, connect_ast,
X            &p[s], 0, 0, &p[s].rhost, 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else
X    {
X      /* TWG */
X      if (p[s].type == SOCK_DGRAM)
X        return (0);
X      st = sys$qio (s, p[s].channel, IO$_CONNECT, p[s].iosb, connect_ast,
X            &p[s], name, namelen, 0, 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X
X  if (p[s].non_blocking)
X    {
X      if (p[s].connected)
X    {
X      if (p[s].connected == 1)
X        return 0;
X      else
X        {
X          p[s].connected = 0;
X          errno = ECONNREFUSED;
X          return -1;
X        }
X    }
X      else
X    {
X      p[s].connect_pending = 1;
X      errno = EINPROGRESS;
X      return -1;
X    }
X    }
X  else
X    {
X      /* wait for the connection to occur */
X      if (p[s].connected)
X    {
X      if (p[s].connected == 1)
X        return 0;
X      else
X        {
X          p[s].connected = 0;
X          errno = ECONNREFUSED;
X          return -1;
X        }
X    }
X
X      /* Timed out? */
X      if (wait_efn (s) == -1)
X    return -1;
X
X      if (p[s].connected != SS$_NORMAL)
X    {
X      errno = ECONNREFUSED;
X      return -1;
X    }
X
X      return 0;
X    }
X}
X
X/* Listen routine.  */
XVMSlisten (s, backlog)
X     int s;
X     int backlog;
X{
X  int st;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  p[s].passive = 1;
X  p[s].backlog = backlog;
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      /* For the CMU sockets we can't do the open call in listen;
X         we have to do it in hang_an_accept, because when we close
X         off the connection we have to be ready to accept another
X         one.  accept() also calls hang_an_accept on the old
X         descriptor.  */
X
X      /* Nothing */
X    }
X      else if (tcp_make == UCX)
X    {
X
X      /* Doc Verbage sez backlog is descriptor of byte.  Doc examples
X         and common sense say backlog is value.  Value doesn't work,
X         so let's try descriptor of byte after all.  */
X      struct descriptor bl;
X      unsigned char ucx_backlog;
X
X      ucx_backlog = (unsigned char) backlog;
X      bl.size = sizeof (ucx_backlog);
X      bl.ptr = (char *) &ucx_backlog;
X
X      st = sys$qiow (0, p[s].channel, IO$_SETMODE, p[s].iosb, 0, 0,
X             0, 0, 0, &bl, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X    }
X      else
X    {
X      /* TWG */
X      st = sys$qiow (0, p[s].channel, IO$_LISTEN, p[s].iosb, 0, 0,
X             backlog, 0, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X
X  p[s].status = LISTENING;
X  hang_an_accept (s);
X  return 0;
X}
X
X/* Accept routine.  */
Xint
XVMSaccept (s, addr, addrlen)
X     int s;
X     union socket_addr *addr;
X     int *addrlen;
X{
X  int news, st;
X  struct descriptor inetdesc;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p[s].non_blocking && !p[s].accept_pending)
X    {
X      errno = EWOULDBLOCK;
X      return -1;
X    }
X
X  /* hang_an_accept set up an incoming connection request so we have first
X     to hang around until one appears or we time out.  */
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      char infobuff[1024];
X
X      /* Timed out?  */
X      if (wait_efn (s) == -1)
X        return -1;
X
X      /* Ok, get a new descriptor ...  */
X      news = dup (0);
X      if (news > 31)
X        {
X          errno = EMFILE;
X          close (news);
X          return -1;
X        }
X
X      /* ... and copy all of our data across.  */
X      bcopy (&p[s], &p[news], sizeof (p[0]));
X
X      /* But not this field, of course! */
X      p[news].s = news;
X
X      sys$qiow (0, p[news].channel, TCP$INFO, p[news].iosb,
X            0, 0, &infobuff, 1024, 0, 0, 0, 0);
X
X      /* Copy across the connection info if necessary.  */
X      if (addr != 0)
X        {
X          *addrlen = sizeof (struct sockaddr_in);
X          bcopy (infobuff + 132, &(addr->in.sin_port), 2);
X          addr->in.sin_port = htons (addr->in.sin_port);
X          addr->in.sin_family = AF_INET;
X          bcopy (infobuff + 272, &(addr->in.sin_addr), 4);
X          p[news].fromlen = *addrlen;
X          bcopy (addr, &(p[news].from), *addrlen);
X        }
X      p[news].status = PASSIVE_CONNECTION;
X
X      /* Get a new file ptr for the socket.  */
X      p[news].fptr = fdopen (news, "r");
X
X      /* Reset this field.  */
X      p[news].accept_pending = 0;
X
X      /* Allocate a buffer.  */
X      p[news].fd_buff = (unsigned char *) malloc (BUF_SIZE);
X      p[news].fd_leftover = 0;
X
X      /* Be prepared to get msgs.  */
X      hang_a_read (news);
X
X      /* Now fix up our previous socket so it's again listening
X         for connections.  */
X      inetdesc.size = 3;
X      inetdesc.ptr = "IP:";
X      if (sys$assign (&inetdesc, &p[s].channel, 0, 0) != SS$_NORMAL)
X        return -1;
X      p[s].status = LISTENING;
X      hang_an_accept (s);
X
X      /* Return the new socket descriptor.  */
X      return news;
X    }
X      else if (tcp_make == UCX)
X    {
X      /* UCX does the actual accept from hang_an_accept.  The accept info
X        is put into the data structure for the "listening" socket.
X        These just need to be copied into a newly allocated socket for
X        the connect and the listening socket re-started.  */
X
X      /* Wait for event flag from accept being received inside
X         of hang_an_accept().  */
X
X      if (wait_efn (s) == -1)
X        /* Timed out.  */
X        return -1;
X
X      /* Ok, get a new descriptor ...  */
X      news = dup (0);
X      if (news > 31)
X        {
X          errno = EMFILE;
X          close (news);
X          return -1;
X        }
X      /* ... and copy all of our data across.  */
X      bcopy (&p[s], &p[news], sizeof (p[0]));
X      p[news].s = news;    /* but not this field */
X      p[news].channel = p[s].ucx_accept_chan;
X
X      /* Initialize the remote host address item_list_3 struct.  */
X      p[news].rhost.length = sizeof (struct sockaddr_in);
X      p[news].rhost.code = 0;
X      p[news].rhost.dataptr = (char *) &p[news].from;
X      p[news].rhost.retlenptr = &p[news].fromdummy;
X
X      if (addr != 0)
X        {
X          /* Return the caller's info, if requested.  */
X          *addrlen = p[news].fromdummy;
X          bcopy (&p[news].from, addr, p[news].fromdummy);
X        }
X
X      /* Finish fleshing out the new structure.  */
X      p[news].status = PASSIVE_CONNECTION;
X
X      /* Get a new file pointer for the socket.  */
X      p[news].fptr = fdopen (news, "r");
X
X      /* Reset this field.  */
X      p[news].accept_pending = 0;
X
X      /* Allocate a buffer.  */
X      p[news].fd_buff = (unsigned char *) malloc (BUF_SIZE);
X      p[news].fd_leftover = 0;
X
X      /* Get it started reading.  */
X      hang_a_read (news);
X
X      p[s].status = LISTENING;
X      hang_an_accept (s);
X
X      return news;
X    }
X      else
X    {
X      /* TWG */
X      struct descriptor inetdesc;
X      int size;
X
X      /* Time out?  */
X      if (wait_efn (s) == -1)
X        return -1;
X
X      /* Ok, get a new descriptor ...  */
X      news = dup (0);
X      if (news > 31)
X        {
X          errno = EMFILE;
X          close (news);
X          return -1;
X        }
X
X      /* Assign a new channel.  */
X      inetdesc.size = 7;
X      inetdesc.ptr = "_INET0:";
X      st = sys$assign (&inetdesc, &p[news].channel, 0, 0);
X      if (QIO_ST_FAILED)
X        {
X          p[s].accept_pending = 0;
X          sys$clref (s);
X          return -1;
X        }
X
X      /* From info needs an int length field! */
X      size = sizeof (p[s].from) + 4;
X      st = sys$qiow (0, p[news].channel, IO$_ACCEPT, p[news].iosb, 0, 0,
X             &p[s].fromdummy, size, p[s].channel, 0, 0, 0);
X
X      if (QIO_ST_FAILED || p[news].iosb[0] != SS$_NORMAL)
X        {
X          p[s].accept_pending = 0;
X          sys$clref (s);
X          return -1;
X        }
X
X      if (addr != 0)
X        {
X          /* Return the caller's info if requested.  */
X          *addrlen = p[s].fromdummy;
X          bcopy (&p[s].from, addr, *addrlen);
X        }
X
X      /* Fix up our new data structure.  */
X      p[news].status = PASSIVE_CONNECTION;
X      p[news].domain = AF_INET;
X      p[news].passive = 1;
X      p[news].fptr = fdopen (news, "r");
X      /* Allocate a buffer.  */
X      p[news].fd_buff = (unsigned char *) malloc (BUF_SIZE);
X
X      /* Be prepared to accept msgs.  */
X      hang_a_read (news);
X
X      /* Get the old descriptor back onto accepting.  */
X      hang_an_accept (s);
X      return news;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X}
X
X/* Recv routine.  */
Xint
XVMSrecv (s, buf, len, flags)
X     int s;
X     char *buf;
X     int len, flags;
X{
X  return recvfrom (s, buf, len, flags, 0, 0);
X}
X
X/* Revfrom routine.  */
Xint
XVMSrecvfrom (s, buf, len, flags, from, fromlen)
X     int s;
X     char *buf;
X     int len, flags;
X     union socket_addr *from;
X     int *fromlen;
X{
X  int number;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p[s].domain != AF_INET && p[s].domain != AF_X25)
X    return -1;
X
X  /* If we're not onto datagrams, then it's possible that a previous
X     call to recvfrom didn't read all the data, and left some behind.
X     So first of all, look in our data buffer for any leftovers that
X     will satisfy this read.  */
X
X  /* We couldn't satisfy the request from previous calls so we must now
X     wait for a message to come through.  */
X  if (wait_efn (s) == -1)
X    /* Timed out.  */
X    return -1;
X
X  if (p[s].closed_by_remote == 1)
X    {
X      /* This could have happened! */
X      errno = ECONNRESET;
X      return -1;
X    }
X
X  if (from != NULL)
X    {
X      if (tcp_make == CMU)
X    {
X      if (p[s].type == SOCK_DGRAM)
X        {
X          /* Not documented but we get the from data from the beginning of
X         the data buffer.  */
X          *fromlen = sizeof (p[s].from.in);
X          from->in.sin_family = AF_INET;
X          bcopy (&p[s].fd_buff[8], &(from->in.sin_port), 2);
X          from->in.sin_port = htons (from->in.sin_port);
X          bcopy (&p[s].fd_buff[0], &(from->in.sin_addr), 4);
X
X          /* Remove the address data from front of data buffer.  */
X          bcopy (p[s].fd_buff + 12, p[s].fd_buff, p[s].fd_buff_size);
X        }
X      else
X        {
X          *fromlen = p[s].fromlen;
X          bcopy (&p[s].from, from, p[s].fromlen);
X        }
X    }
X      else if (tcp_make == UCX)
X    {
X      *fromlen = p[s].fromdummy;
X      bcopy (&p[s].from, from, p[s].fromdummy);
X    }
X      else
X    {
X      *fromlen = p[s].fromlen;
X      bcopy (&p[s].from, from, p[s].fromlen);
X    }
X    }
X
X  /* We may've received too much.  */
X  number = p[s].fd_buff_size;
X  if (number <= len)
X    {
X      /* If we haven't give back all the data available.  */
X      bcopy (p[s].fd_buff, buf, number);
X      p[s].fd_leftover = 0;
X      hang_a_read (s);
X      return (number);
X    }
X  else
X    {
X      /* If we have too much data then split it up.  */
X      p[s].fd_leftover = p[s].fd_buff;
X      bcopy (p[s].fd_leftover, buf, len);
X      /* And change the pointers.  */
X      p[s].fd_leftover += len;
X      p[s].fd_buff_size -= len;
X      return (len);
X    }
X}
X
X/* Send routine.  */
Xint
XVMSsend (s, msg, len, flags)
X     int s;
X     char *msg;
X     int len, flags;
X{
X  return sendto (s, msg, len, flags, 0, 0);
X}
X
X/* Sendto routine.  */
Xint
XVMSsendto (s, msg, len, flags, to, tolen)
X     int s;
X     unsigned char *msg;
X     int len, flags;
X     union socket_addr *to;
X     int tolen;
X{
X  int i, j, st, size;
X  unsigned char udpbuf[BUF_SIZE + 12];
X  char infobuff[1024], lhost[32];
X  unsigned short int temp;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  /* First remember who we sent it to and set the value of size.  */
X  if (to != 0)
X    {
X      p[s].tolen = tolen;
X      bcopy (to, &(p[s].to), tolen);
X      size = tolen;
X    }
X  else
X    size = 0;
X
X  if (p[s].domain == AF_INET)
X    {
X      /* We might never have started a read for udp (socket/sendto) so
X     put one here.  */
X      if (p[s].type == SOCK_DGRAM)
X    hang_a_read (s);
X
X      if (tcp_make == CMU)
X    {
X      if (p[s].type == SOCK_DGRAM)
X        {
X          /* We might never have opened up a udp connection yet,
X         so check.  */
X          if (p[s].cmu_open != 1)
X        {
X          st = sys$qiow (0, p[s].channel, TCP$OPEN, p[s].iosb, 0, 0,
X                 0, 0, 0, 0, 1, 0);
X          if (QIO_ST_FAILED)
X            return -1;
X
X          p[s].cmu_open = 1;
X          sys$qiow (0, p[s].channel, TCP$INFO, p[s].iosb,
X                0, 0, &infobuff, 1024, 0, 0, 0, 0);
X          bcopy (infobuff + 264, &(p[s].name.in.sin_port), 2);
X          p[s].name.in.sin_port = htons (p[s].name.in.sin_port);
X          bcopy (infobuff + 136, lhost, infobuff[1]);
X          lhost[infobuff[1]] = '\0';
X          sys$qiow (0, p[s].channel, GTHST, p[s].iosb,
X                0, 0, &infobuff, 1024, 1, lhost, 0, 0);
X          bcopy (infobuff + 4, &(p[s].name.in.sin_addr), 4);
X        }
X
X          /* This isn't well documented.  To send to a UDP socket, we
X         need to put the address info at the beginning of the
X         buffer.  */
X          bcopy (msg, udpbuf + 12, len);
X          bcopy (&p[s].to.in.sin_addr, udpbuf + 4, 4);
X          temp = ntohs (p[s].to.in.sin_port);
X          bcopy (&temp, udpbuf + 10, 2);
X          bcopy (&p[s].name.in.sin_addr, udpbuf, 4);
X          temp = ntohs (p[s].name.in.sin_port);
X          bcopy (&temp, udpbuf + 8, 2);
X          temp = len + 12;
X          st = sys$qiow (0, p[s].channel, TCP$SEND, p[s].iosb, 0, 0,
X                 udpbuf, temp, 0, 0, 0, 0);
X          if (QIO_FAILED)
X        return -1;
X        }
X      else
X        {
X          /* TCP (! UDP)  */
X          st = sys$qiow (0, p[s].channel, TCP$SEND, p[s].iosb, 0, 0,
X                 msg, len, 0, 0, 0, 0);
X          if (QIO_FAILED)
X        return -1;
X        }
X      return len;
X    }
X      else if (tcp_make == UCX)
X    {
X      struct itemlist rhost;
X      rhost.length = sizeof (struct sockaddr_in);
X      rhost.code = 0;
X      rhost.dataptr = (char *) &p[s].to;
X
X      st = sys$qiow (0, p[s].channel, IO$_WRITEVBLK, p[s].iosb, 0, 0,
X             msg, len, &rhost, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return len;
X    }
X      else
X    {
X      /* TWG */
X      st = sys$qiow (0, p[s].channel, IO$_WRITEVBLK, p[s].iosb,
X             0, 0, msg, len, 0, &p[s].to, size, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return len;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X}
X
X/* Getsockname routine.  */
Xint
XVMSgetsockname (s, name, namelen)
X     int s;
X     union socket_addr *name;
X     int *namelen;
X{
X  int st;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      /* For CMU we just return values held in our data structure.  */
X      *namelen = p[s].namelen;
X      bcopy (&(p[s].name), name, *namelen);
X      return (0);
X    }
X      else if (tcp_make == UCX)
X    {
X      /* An item_list_3 descriptor.  */
X      struct itemlist lhost;
X
X      lhost.length = *namelen;
X      lhost.code = 0;
X      lhost.dataptr = (char *) name;
X
X      /* Fill in namelen with actual ret len value.  */
X      lhost.retlenptr = (short int *) namelen;
X
X      st = sys$qiow (0, p[s].channel, IO$_SENSEMODE, p[s].iosb, 0, 0,
X             0, 0, &lhost, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return 0;
X    }
X      else
X    {
X      /* TWG gives us the information. */
X      st = sys$qiow (0, p[s].channel, IO$_GETSOCKNAME, p[s].iosb,
X             0, 0, name, namelen, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return 0;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X}
X
X/* Select routine.  */
Xint
XVMSselect (nfds, readfds, writefds, exceptfds, timeout)
X     int nfds;
X     fd_set *readfds, *writefds, *exceptfds;
X     struct timeval *timeout;
X{
X  int timer, fd, alarm_set, total, end;
X  long mask, cluster;
X  struct descriptor termdesc;
X  static fd_set new_readfds, new_writefds, new_exceptfds;
X
X  FD_ZERO (&new_readfds);
X  FD_ZERO (&new_writefds);
X  FD_ZERO (&new_exceptfds);
X  total = 0;
X
X  /* Assign a terminal channel if we haven't already.  */
X  if (terminal.chan == -1)
X    {
X      termdesc.size = 10;
X      termdesc.ptr = "SYS$INPUT:";
X      sys$assign (&termdesc, &terminal.chan, 0, 0);
X    }
X  alarm_set = 0;
X  if (timeout != NULL)
X    {
X      /* If a timeout is given then set the alarm.  */
X      end = timeout->tv_sec;
X      if (timer != 0)
X    {
X      /* We need to reset the alarm if it didn't fire, but we set it.  */
X      alarm_set = 1;
X      si_alarm (end);
X    }
X    }
X  else
X    end = 1;
X
X  do
X    {
X      if (exceptfds)
X    {
X       /* Nothing */ ;
X    }
X
X      if (writefds)
X    {
X      for (fd = 0; fd < nfds; fd++)
X        if (FD_ISSET (fd, writefds))
X          {
X        if (p[fd].connect_pending)
X           /* Nothing */ ;
X        else if ((p[fd].status == ACTIVE_CONNECTION)
X             || (p[fd].status == PASSIVE_CONNECTION))
X          {
X            FD_SET (fd, &new_writefds);
X            total++;
X          }
X          }
X    }
X
X      if (readfds)
X    {
X      /* True if data pending or an accept.  */
X      for (fd = 3; fd < nfds; fd++)
X        if (FD_ISSET (fd, readfds) &&
X        ((p[fd].fd_buff_size != -1) || (p[fd].accept_pending == 1)))
X          {
X        FD_SET (fd, &new_readfds);
X        total++;
X          }
X    }
X
X      if (total || (end == 0))
X    break;
X
X      /* Otherwise, wait on an event flag.  It's possible that the wait can
X     be stopped by a spurious event flag being set -- i.e. one that's
X     got a status not normal.  So we've got to be prepared to loop
X     around the wait until a valid reason happens.  */
X
X      /* Set up the wait mask.  */
X      cluster = 0;
X      mask = 0;
X      for (fd = 3; fd < nfds; fd++)
X    {
X      sys$clref (fd);
X      if (readfds)
X        if FD_ISSET
X          (fd, readfds) mask |= (1 << fd);
X      if (writefds)
X        if FD_ISSET
X          (fd, writefds) mask |= (1 << fd);
X      if (exceptfds)
X        if FD_ISSET
X          (fd, exceptfds) mask |= (1 << fd);
X    }
X
X      mask |= (1 << TIMER_EFN);
X
X      /* Clear it off just in case.  */
X      sys$clref (TIMER_EFN);
X
X      /* Wait around.  */
X      sys$wflor (cluster, mask);
X
X      mask = 0;
X      if (read_efn (TIMER_EFN))
X    {
X      errno = EINTR;
X      break;
X    }
X  } while (1);
X  /*NOTREACHED*/
X
X  /* Unset the alarm if we set it.  */
X  if (alarm_set == 1)
X    alarm (0);
X
X  if (readfds)
X    *readfds = new_readfds;
X
X  if (writefds)
X    *writefds = new_writefds;
X
X  if (exceptfds)
X    *exceptfds = new_exceptfds;
X
X  return total;
X}
X
X/* Shutdown routine.  */
XVMSshutdown (s, how)
X     int s, how;
X{
X  int st;
X  int ucx_how;
X
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      /* For CMU we just close off.  */
X      si_close (s);
X      return 0;
X    }
X      else if (tcp_make == UCX)
X    {
X      st = sys$qiow (0, p[s].channel, IO$_DEACCESS | IO$M_SHUTDOWN,
X             p[s].iosb, 0, 0, 0, 0, 0, how, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return 0;
X    }
X      else
X    {
X      /* TWG lets us do it.  */
X      st = sys$qiow (0, p[s].channel, IO$_SHUTDOWN, p[s].iosb, 0, 0, how,
X             0, 0, 0, 0, 0);
X      if (QIO_FAILED)
X        return -1;
X
X      return 0;
X    }
X    }
X  else                /* it wasn't a socket */
X    return -1;
X}
X
X/*  */
X
X/* The following routines are used by the above socket calls.  */
X
X/* hang_a_read sets up a read to be finished at some later time.  */
Xhang_a_read (s)
X     int s;
X{
X  extern int read_ast ();
X  int size, st;
X
X  /* Don't bother if we already did it.  */
X  if (p[s].read_outstanding == 1)
X    return;
X
X  /* Have a read outstanding.  */
X  p[s].read_outstanding = 1;
X  size = sizeof (p[s].from) + 4;
X  sys$clref (s);
X
X  /* Clear off the event flag just in case, and reset the buf size.  */
X  p[s].fd_buff_size = -1;
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      st = sys$qio (s, p[s].channel, TCP$RECEIVE, p[s].iosb, read_ast,
X            &p[s], p[s].fd_buff, BUF_SIZE, 0, 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else if (tcp_make == UCX)
X    {
X
X      p[s].rhost.length = sizeof (struct sockaddr_in);
X      p[s].rhost.code = 0;
X      p[s].rhost.dataptr = (char *) &p[s].from;
X      p[s].rhost.retlenptr = &p[s].fromdummy;
X
X      st = sys$qio (s, p[s].channel, IO$_READVBLK, p[s].iosb, read_ast,
X            &p[s], p[s].fd_buff, BUF_SIZE, &p[s].rhost, 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else
X    {
X      /* TWG */
X      st = sys$qio (s, p[s].channel, IO$_READVBLK, p[s].iosb, read_ast,
X            &p[s], p[s].fd_buff, BUF_SIZE, 0, &p[s].fromlen,
X            size, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X}
X
X/* hang_an_accept waits for a connection request to come in.  */
Xhang_an_accept (s)
X     int s;
X{
X  extern int accept_ast ();
X  int st;
X
X  /* Clear the event flag just in case.  */
X  sys$clref (s);
X
X  /* Reset our flag & buf size.  */
X  p[s].accept_pending = 0;
X  p[s].fd_buff_size = -1;
X  if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X    {
X      st = sys$qio (s, p[s].channel, TCP$OPEN, p[s].iosb, accept_ast,
X            &p[s], 0, 0, ntohs (p[s].name.in.sin_port), 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else if (tcp_make == UCX)
X    {
X      struct descriptor inetdesc;
X
X      /* Assign channel for actual connection off listener.  */
X      inetdesc.size = 3;
X      inetdesc.ptr = "BG:";
X      if (sys$assign (&inetdesc, &p[s].ucx_accept_chan, 0,
X              0) != SS$_NORMAL)
X        return -1;
X
X      /* UCX's accept returns remote host info and the channel for a new
X         socket to perform reads/writes on, so a sys$assign isn't
X         really necessary.  */
X      p[s].rhost.length = sizeof (struct sockaddr_in);
X      p[s].rhost.dataptr = (char *) &p[s].from;
X      p[s].fromdummy = 0;
X      p[s].rhost.retlenptr = &p[s].fromdummy;
X
X      st = sys$qio (s, p[s].channel, IO$_ACCESS | IO$M_ACCEPT, p[s].iosb,
X            accept_ast, &p[s], 0, 0, &p[s].rhost,
X            &p[s].ucx_accept_chan, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X      else
X    {
X      st = sys$qio (s, p[s].channel, IO$_ACCEPT_WAIT, p[s].iosb,
X            accept_ast, &p[s], 0, 0, 0, 0, 0, 0);
X      if (QIO_ST_FAILED)
X        return -1;
X    }
X    }
X  else
X    /* We don't handle any other domain yet.  */
X    return -1;
X}
X
X/* wait_efn just sets up a wait on either an event or the timer.  */
Xwait_efn (s)
X     int s;
X{
X  long mask, cluster;
X
X  cluster = 0;
X  sys$clref (TIMER_EFN);
X  mask = (1 << s) | (1 << TIMER_EFN);
X  sys$wflor (cluster, mask);
X
X  if (read_efn (TIMER_EFN))
X    {
X      errno = EINTR;
X      return -1;
X    }
X
X  return 0;
X}
X
X/* read_ast is called by the system whenever a read is done.  */
Xread_ast (p)
X     struct fd_entry *p;
X{
X  int i, j;
X  unsigned char *v, *w;
X
X  /* Reset the outstanding flag.  */
X  p->read_outstanding = 0;
X  if (p->iosb[0] == SS$_NORMAL)
X    {
X      /* Check no errors.  */
X      p->fd_buff_size = p->iosb[1];
X      if (tcp_make == CMU)
X    {
X      /* fiddle for DGRMs */
X      if (p->type == SOCK_DGRAM)
X        p->fd_buff_size -= 12;
X    }
X      if (p->sig_req == 1)
X    gsignal (SIGIO);
X    }
X  else if (p->iosb[0] == SS$_CLEARED)
X    p->closed_by_remote = 1;
X  else if (tcp_make == UCX)
X    {
X      if (p->iosb[0] == SS$_LINKDISCON)
X    p->closed_by_remote = 1;
X    }
X}
X
X/* accept_ast is called whenever an incoming call is detected.  */
Xaccept_ast (p)
X     struct fd_entry *p;
X{
X  if (p->iosb[0] == SS$_NORMAL)
X    p->accept_pending = 1;
X  else
X    /* If it failed set up another listen.  */
X    listen (p->s, p[p->s].backlog);
X}
X
X/* connect_ast is called whenever an async connect is made.  */
Xconnect_ast (p)
X     struct fd_entry *p;
X{
X  p->connect_pending = 0;
X  if ((p->connected = p->iosb[0]) == SS$_NORMAL)
X    {
X      /* We made the connection.  */
X      p->status = ACTIVE_CONNECTION;
X
X      /* Be prepared to accept a msg.  */
X      hang_a_read (p->s);
X    }
X}
X
X/*  */
X/* These routines handle stream I/O.  */
X
X/* si_close -- must close off any connection in progress.  */
Xsi_close (s)
X     int s;
X{
X  if (!tcp_make)
X    set_tcp_make ();
X
X  if ((s < 0) || (s > 31))
X    return -1;
X
X  if (p[s].channel != 0)
X    {
X      /* Was it one of our descriptors? */
X      if (p[s].domain == AF_INET)
X    {
X      if (tcp_make == CMU)
X        sys$qiow (0, p[s].channel, TCP$CLOSE, p[s].iosb,
X              0, 0, 0, 0, 0, 0, 0, 0);
X      if (p[s].status != HANDED_OFF)
X        sys$dassgn (p[s].channel);
X      close (s);
X      free (p[s].fd_buff);
X      p_initialise (s);
X    }
X      return 0;
X    }
X  else
X    {
X      /* Re-initialise data structure just in case.  */
X      p[s].fd_buff_size = -1;
X      p[s].accept_pending = 0;
X      p[s].status = INITIALISED;
X      return close (s);
X    }
X}
X
X/* si_alarm -- insert a call to our own alarm function.  */
Xsi_alarm (i)
X     int i;
X{
X  extern int pre_alarm ();
X
X  /* Make the call to pre_alarm instead of what the user wants;
X     pre_alarm will call his routine when it finishes.  */
X  /* VAX needs this call each time! */
X  signal (SIGALRM, pre_alarm);
X  alarm (i);
X}
X
X/* pre_alarm -- gets called first on an alarm signal.  */
Xpre_alarm ()
X{
X  /* Come here first so we can set our timer event flag.  */
X  sys$setef (TIMER_EFN);
X  (*alarm_function) ();
X}
X
X/* p_initialise - initialise our data array.  */
Xp_initialise (s)
X     int s;
X{
X  int j;
X  for (j = 0; j < 4; j++)
X    p[s].iosb[j] = 0;
X  p[s].channel = 0;
X  p[s].fd_buff_size = -1;
X  p[s].accept_pending = 0;
X  p[s].connect_pending = 0;
X  p[s].connected = 0;
X  p[s].fd_buff = NULL;
X  p[s].fd_leftover = NULL;
X  p[s].fptr = NULL;
X  p[s].s = s;
X  p[s].name.in.sin_port = 0;
X  p[s].masklen = 4;
X  for (j = 0; j < 16; j++)
X    p[s].mask[j] = 0xff;
X  p[s].need_header = 0;
X  p[s].status = INITIALISED;
X  p[s].read_outstanding = 0;
X  p[s].cmu_open = 0;
X  p[s].x25_listener = 0;
X  p[s].mother = s;
X  p[s].child = 0;
X  p[s].no_more_accepts = 0;
X  p[s].closed_by_remote = 0;
X  p[s].non_blocking = 0;
X  p[s].sig_req = 0;
X  sys$clref (s);
X}
X
X/* read_efn -- see whether an event flag is set.  */
Xread_efn (i)
X     int i;
X{
X  int j;
X  sys$readef (i, &j);
X  j &= (1 << i);
X
X  return j;
X}
X
Xstatic
Xset_tcp_make ()
X{
X  struct descriptor inetdesc;
X  int channel;
X  /* first try CMU */
X  inetdesc.size = 3;
X  inetdesc.ptr = "IP:";
X  if (sys$assign (&inetdesc, &channel, 0, 0) == SS$_NORMAL)
X    {
X      sys$dassgn (channel);
X      tcp_make = CMU;
X      return;
X    }
X
X  /* next try TWG */
X  inetdesc.size = 7;
X  inetdesc.ptr = "_INET0:";
X  if (sys$assign (&inetdesc, &channel, 0, 0) == SS$_NORMAL)
X    {
X      sys$dassgn (channel);
X      tcp_make = WG;
X      return;
X    }
X
X  /* next try UCX */
X  inetdesc.size = 4;
X  inetdesc.ptr = "BG0:";
X  if (sys$assign (&inetdesc, &channel, 0, 0) == SS$_NORMAL)
X    {
X      sys$dassgn (channel);
X      tcp_make = UCX;
X      return;
X    }
X
X  /* nothing there oh dear!*/
X  tcp_make = NONE;
X  return;
X}
X
Xstatic char *
Xgetdevicename (channel)
X     unsigned short int channel;
X{
X  int st;
X  struct
X  {
X    struct itemlist id;
X    int eol;
X  } itmlst;
X  static char name[64];
X  short int lgth;
X
X  name[0] = '\0';
X  itmlst.id.code = DVI$_DEVNAM;
X  itmlst.id.length = 64;
X  itmlst.id.dataptr = name;
X  itmlst.id.retlenptr = &lgth;
X  itmlst.eol = 0;
X  st = sys$getdvi (0, channel, 0, &itmlst, 0, 0, 0, 0);
X  if (QIO_ST_FAILED)
X    fprintf (stderr, "error getting device name %d\n", st);
X
X  return (name);
X}
END_OF_FILE
  if test 32780 -ne `wc -c <'./vms_support.c'`; then
    echo shar: \"'./vms_support.c'\" unpacked with wrong size!
  fi
  # end of './vms_support.c'
fi
echo shar: End of archive 1 \(of 5\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 4 5 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 5 archives.
    rm -f ark[1-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...