+-+-+-+ Beginning of part 13 +-+-+-+
X    int process_info;`009`009`009/* Do we need to use this? */
X    int end_of_header;`009`009`009/* Found end of the header? */
X    int temp_char_in;`009`009`009/* Place to stuff fgetc()s */
X
X    /* Do we use our own or get it from what was passed to us? */
X
X    if (!p) `123
X`009p = src.p;
X    `125
X
X    /* Clear out the last info we scanned */
X
X    for (cur = p; cur->id[0]; cur++) `123
X#ifdef DEBUG
X`009printf("scan_header: clearing text for >%s<\n", cur->id);
X#endif
X`009memset(cur->header_text, 0, cur->reg_text_length+SLOP_LEN);
X    `125
X
X    /* Wait until we get something that's non blank */
X
X#ifdef DEBUG
X    printf("scan_header: searching for beginning\n");
X#endif
X
X    do `123
X`009if (!fgets_lcl(line, 255, note)) `123
X`009    break;
X`009`125
X    `125 while (line[0] == ' ' `124`124 line[0] == '\n' `124`124 !line[0]);
X
X#ifdef DEBUG
X    printf("scan_header: processing line:\n");
X    printf("   >%s<\n", line);
X#endif
X
X    /* Bail out if we've hit EOF */
X
X    if (feof(note)) `123
X`009return;
X    `125
X
X#ifdef DEBUG
X    printf("scan_header: Ready to start on the header\n");
X#endif
X
X    /* Start reading through the header */
X
X    end_of_header = FALSE;
X
X    while (!end_of_header) `123
X
X`009/* Wade through the header pieces */
X
X`009strcpy(temp, line);
X`009strlwr(temp);
X
X`009for (cur = p; cur->id[0]; cur++) `123
X#ifdef DEBUG
X`009    printf("scan_header: comparing against >%s<\n", cur->scan_text);
X#endif
X`009    if (hdr_item_found(temp, cur)) `123
X`009`009break;
X`009    `125
X`009`125
X
X`009/* Did we get a match on anything? */
X
X`009process_info = (cur->id[0]);
X
X`009/* If we're working on something, start parsing it */
X
X`009if (process_info) `123
X
X#ifdef DEBUG
X`009    printf("scan_header: got header for %s\n", cur->scan_text);
X#endif
X
X`009    /* First wipe out anything previous, for multiple tags */
X
X`009    memset(cur->header_text, 0, cur->reg_text_length+SLOP_LEN);
X
X`009    /* Skip past the Header tag (To:, etc.) */
X
X`009    strcpy(line, line+strlen(cur->scan_text));
X
X`009    /* And tack on the line */
X
X`009    scrunch(line);
X`009    build_header_line(cur, line);
X`009`125
X
X`009/* Now let's finish out the tag */
X
X`009while (TRUE) `123
X
X`009    /* Get the first character of the next line */
X
X`009    temp_char_in = fgetc(note);
X
X`009    if (temp_char_in == EOF) `123
X`009`009return; `009`009/* Run away if we ran out of file */
X`009    `125
X`009    line[0] = (char) temp_char_in;
X
X`009    /* This determines what we need to do next */
X
X`009    if (line[0] == ' ' `124`124 line[0] == '\t') `123
X`009`009fgets_lcl(line, 255, note);
X`009`009if (feof(note)) `123
X`009`009    return;
X`009`009`125
X`009`009if (!line[0]) `123 `009/* Unless it's a blank line */
X`009`009    end_of_header = TRUE;   /* THAT means that we're done */
X`009`009    break;
X`009`009`125
X`009`009if (process_info) `123`009/* We're using this, so use it */
X`009`009    scrunch(line);
X`009`009    strcat(cur->header_text, " ");  /* Space between lines */
X`009`009    build_header_line(cur, line);
X`009`009`125
V`009    `125 else if (line[0] == '\n') `123   /* Completely blank, means EOH
X */
X`009`009end_of_header = TRUE;
X`009`009break;
X`009    `125 else `123`009`009`009/* Otherwise, just stick it back out */
X`009`009ungetc(line[0], note);
X`009`009break;
X`009    `125
X`009`125
X
X`009/* If we're not done, read the next piece of the header */
X
X`009if (!end_of_header) `123
X`009    fgets_lcl(line, 255, note);
X`009    if (feof(note)) `123
X`009`009return;
X`009    `125
X`009`125
X    `125
X    return;
X`125
X
X/* Glue the line onto what we currently have */
X
Xstatic void build_header_line(struct source_info * cur, char * line)
X`123
X    /* Do we already have sufficient text? */
X
X    if (strlen(cur->header_text) == cur->reg_text_length) `123
X`009return;
X    `125
X
X    /* Just tack it onto the end */
X
X    strncat(cur->header_text, line, cur->reg_text_length -
X`009    strlen(cur->header_text));
X`125
X
X/* Do we have a match on this scan text? */
X
Xstatic int hdr_item_found(char * line, struct source_info * cur)
X`123
X    return (!strncmp(line, cur->scan_text, strlen(cur->scan_text)));
X`125
X
X/* Give me information about a digest format */
X
Xint digest_find(char dig_type, int * len, int * error)
X`123
X    struct digest_def * cur;`009`009/* What we're looking at */
X
X    /* Is there anything there? */
X
X    if (!dig.p) `123
X`009return (FALSE);
X    `125
X
X    for (cur = dig.p; cur->digest_id; cur++) `123
X`009if (cur->digest_id != dig_type) `123
X`009    continue;
X`009`125
X`009*len = cur->split_len;
X`009*error = cur->split_error;
X`009return (TRUE);
X    `125
X    return (FALSE);
X`125
X
X/* Do we ignore messages from this user/node combination */
X
Xint ignore_msgs(char * n, char * u)
X`123
X    struct ignore_list * cur;`009`009/* Skip through */
X    struct dsc$descriptor_s pat;`009/* Pattern to use */
X    struct dsc$descriptor_s cand_n;`009/* Candidate for node */
X    struct dsc$descriptor_s cand_u;`009/* Candidate for user */
X
X    /* Are there any users to ignore? */
X
X    if (!ign.p) `123
X`009return (FALSE);
X    `125
X
X    /* Build some descriptors */
X
X    str_desc(&cand_n, n);
X    str_desc(&cand_u, u);
X
X    /* Let's look through the list and see if we get a match */
X
X    for (cur = ign.p; cur->node[0] `124`124 cur->user[0]; cur++) `123
X
X`009str_desc(&pat, cur->node);
X`009if (str$match_wild(&cand_n, &pat) == STR$_NOMATCH) `123
X`009    continue;
X`009`125
X
X`009str_desc(&pat, cur->user);
X`009if (str$match_wild(&cand_u, &pat) == STR$_NOMATCH) `123
X`009    continue;
X`009`125
X
X`009return (TRUE);
X    `125
X    return (FALSE);
X`125
X
X/* Is this user allowed to tell us real commands? */
X
Xint valid_manager(char * n, char * u)
X`123
X    struct manager_list * cur;
X
X    /* If you're not local, we're not listening */
X
X    if (strcmp(n, host)) `123
X`009return (FALSE);
X    `125
X
X    /* If you're not in the list, we're not interested */
X
X    for (cur = man.p; cur->user[0]; cur++) `123
X`009if (!strcmp(u, cur->user)) `123
X`009    return (TRUE);
X`009`125
X    `125
X
X    return (FALSE);
X`125
X
X/* Is the passed link one of the ones that must be down? */
X
Xint mandatory_link(char * l)
X`123
X    struct link_info * cur;
X
X    /* If there aren't any, there aren't any */
X
X    if (!lnk.p) `123
X`009return(FALSE);
X    `125
X
X    /* Scan through to see if it's on the mandatory list */
X
X    for (cur = lnk.p; cur->link[0]; cur++) `123
X`009if (!strcmp(cur->link, l)) `123
X`009    return (TRUE);
X`009`125
X    `125
X    return (FALSE);
X`125
X
X#if defined(DEBUG) && (DEBUG & 1)
Xvoid dump_control_file(void)
X`123
X    struct list_info * c_lst;
X    struct source_info * c_src;
X    struct rule_info * c_rul;
X    struct digest_def * c_dig;
X    struct manager_list * c_man;
X    struct link_info * c_lnk;
X    struct ignore_list * c_ign;
X
X    FILE * out;
X
X    sprintf(temp, "%sRULES.OUT", scratch_dir.dsc$a_pointer);
X
X    out = fopen(temp, "w", "ctx=rec", "rat=cr", "rfm=var");
X
X    fprintf(out, "Lists: %d\n", lst.count);
X    for (c_lst = lst.p; c_lst->scan_data[0]; c_lst++) `123
X`009fprintf(out, ">%s< >%s< >%s< %c %c %s\n", c_lst->scan_data,
X`009`009c_lst->conf_hdr, c_lst->conf_user, (c_lst->flag_digest ? 'Y' :
X`009`009'N'), c_lst->new_topic_interval, c_lst->conf_name);
X    `125
X
X    fprintf(out, "\nSources: %d\n", src.count);
X    for (c_src = src.p; c_src->id[0]; c_src++) `123
X`009fprintf(out, "%s >%s< %d\n", c_src->id, c_src->scan_text,
X`009`009c_src->reg_text_length);
X    `125
X
X    fprintf(out, "\nRules: %d\n", rul.count);
X    for (c_rul = rul.p; c_rul->comparison[0]; c_rul++) `123
X`009fprintf(out, "%s %s %s %s %s %s\n", c_rul->ids[0], c_rul->comparison,
X`009`009c_rul->ids[1], c_rul->action, c_rul->id_from, c_rul->id_subj);
X    `125
X
X    fprintf(out, "\nDigests: %d\n", dig.count);
X    if (!dig.p) `123
X`009fputs("None\n", out);
X    `125 else `123
X`009for (c_dig = dig.p; c_dig->digest_id; c_dig++) `123
X`009    fprintf(out, "%c %d/%d\n", c_dig->digest_id, c_dig->split_len,
X`009`009    c_dig->split_error);
X`009`125
X    `125
X
X    fprintf(out, "\nManagers: %d\n", man.count);
X    for (c_man = man.p; c_man->user[0]; c_man++) `123
X`009fprintf(out, "%s\n", c_man->user);
X    `125
X
X    fprintf(out, "\nLinks: %d\n", lnk.count);
X    if (!lnk.p) `123
X`009fputs("None\n", out);
X    `125 else `123
X`009for (c_lnk = lnk.p; c_lnk->link[0]; c_lnk++) `123
X`009    fprintf(out, "%s\n", c_lnk->link);
X`009`125
X    `125
X
X    fprintf(out, "\nIgnores: %d\n", ign.count);
X    if (!ign.p) `123
X`009fputs("None\n", out);
X    `125 else `123
X`009for (c_ign = ign.p; c_ign->node[0]; c_ign++) `123
X`009    fprintf(out, "%s@%s\n", c_ign->user, c_ign->node);
X`009`125
X    `125
X
X    fclose(out);
X`125
X#endif
$ GOSUB UNPACK_FILE

$ FILE_IS = "RUN_BBOARD_DAEMON.COM"
$ CHECKSUM_IS = 154929500
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ purge/keep=3 Bboard_Dir:bboard.out
X$ purge/keep=1 Bboard_Dir:bboard.notelog
X$ run Bboard_Dir:Bboard
$ GOSUB UNPACK_FILE

$ FILE_IS = "SETUNAME.COM"
$ CHECKSUM_IS = 1462191140
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ MESSAGE SETUNAMEMSG
X$ SET COMMAND/OBJECT SETUNAMECLD
X$ MACRO SETUNAMESUB
X$ PASCAL SETUNAME
X$ LINK SETUNAME,SETUNAMESUB,SETUNAMEMSG,SETUNAMECLD
$ GOSUB UNPACK_FILE

$ FILE_IS = "SETUNAME.PAS"
$ CHECKSUM_IS = 1346175731
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
V[IDENT('V1.0'),`009`009    `123 Update this with the version constant below `
X125
XINHERIT ('SYS$LIBRARY:STARLET.PEN')]
XPROGRAM SETUNAME(OUTPUT);
X
X`123 This program when used as a foreign command allows a suitably priviliged
X  user to change his username to that of another user.  This program is a
X  gutted version of Eric Wentz' BECOME V1.8
X`125
X
XCONST
V    VER_STRING = 'V1.0';`009`009    `123 Update with version in the header`12
X5
X
XTYPE
X    UBYTE`009    = [BYTE] 0..255;
X    UWORD`009    = [WORD] 0..65535;
X    UQUAD`009    = [QUAD,UNSAFE] RECORD L0,L1:UNSIGNED;END;
X    USERNAME_TYPE   = PACKED ARRAY [1..12] OF CHAR;
X
X    ITEM_LIST_TYPE = RECORD
X`009BUFFER_LENGTH`009: UWORD;
X`009ITEM_CODE`009: UWORD;
X`009BUFFER_ADDRESS`009: UNSIGNED;
X`009RETURN_LEN_ADDR`009: UNSIGNED;
X`009END;
X
X    UIC_TYPE = RECORD CASE INTEGER OF
X    1:(UIC  : INTEGER);
X    2:(MEMBER`009: UWORD;
X       GROUP`009: UWORD);
X       END;
X
X(********** Define the variables used by the program ************)
X
XVAR
X    ISTAT`009: [VOLATILE] INTEGER;
X    NEW_USERNAME: USERNAME_TYPE;
X    SETUP_PRIVS`009: UQUAD:=0;
X    ERRMSG`009: VARYING[255] OF CHAR;
X
X`123
XLocal storage for $GETUAI items (from UAF file)
X`125
X    UIC`009`009: [VOLATILE] UIC_TYPE;
X    GETUAI_LIST`009: ARRAY [1..2] OF ITEM_LIST_TYPE:=ZERO;
X`123
XDefine the variables for the message numbers
X`125
X    SETUNAME_UAFNOTFOU,
X    SETUNAME_VERSION,
X    SETUNAME_BECAME,
X    SETUNAME_NOUSER`009: [EXTERNAL,VALUE] INTEGER;
X
X    COMMAND_STRING : VARYING [80] OF CHAR;
V    SETUNAMECLD : [EXTERNAL,VALUE] INTEGER;`009`123 Parsing tables for CLI
X    `125
X
X(******** Functions that reside in SETUNAMESUB.MAR ************)
X
XPROCEDURE SET_USERNAME`009(VAR USERNAME`009: USERNAME_TYPE);`009EXTERNAL;
X
V(****************************************************************************
X**)
V(***************   Define RTL routines  *************************************
X**)
V(****************************************************************************
X**)
X
X[ASYNCHRONOUS] PROCEDURE LIB$STOP
X  (%IMMED Cond_Value :INTEGER);EXTERNAL;
X
XFUNCTION LIB$GET_FOREIGN(
X`009var get_str : [CLASS_S] PACKED ARRAY
X`009[$L1..$U1:INTEGER] OF CHAR;
X`009var user_prompt : [CLASS_S,READONLY] PACKED ARRAY
X`009[$L2..$U2:INTEGER] OF CHAR := %IMMED 0;
X`009var out_len : UWORD := %IMMED 0;
X`009var force_prompt : [CLASS_S,READONLY] PACKED ARRAY
X`009[$L3..$U3:INTEGER] OF CHAR := %IMMED 0):integer; external;
X
XPROCEDURE LIB$PUT_OUTPUT(
V    VAR STR : [READONLY,CLASS_S] PACKED ARRAY [A..B:INTEGER] OF CHAR);EXTERNA
XL;
X
XPROCEDURE LIB$ENABLE_CTRL(
X`009VAR ENABLE_MSK : [READONLY] UNSIGNED);EXTERNAL;
X
XPROCEDURE LIB$DISABLE_CTRL(
X`009VAR DISABLE_MSK : [READONLY] UNSIGNED);EXTERNAL;
X
X`123 Somebody blew it, this should be defined in STARLET !! `125
X[ASYNCHRONOUS,EXTERNAL(SYS$SETDDIR)]
XFUNCTION $SETDDIR(
V    VAR NEW_DIR_ADDR : [READONLY,CLASS_S] PACKED ARRAY [A..B:INTEGER] OF CHAR
X;
X    VAR LENGTH_ADDR : UWORD := %IMMED 0;
X    VAR CUR_DIR_ADDR : [CLASS_S] PACKED ARRAY
X`009[C..D:INTEGER] OF CHAR := %IMMED 0):INTEGER;EXTERNAL;
X
XVAR`009`009    `123 Define CLI utility conditions `125
X  CLI$_NOCOMD,
X  CLI$_INVROUT,
X  CLI$_COMMA,
X  CLI$_CONCAT,
X  CLI$_ABSENT,
X  CLI$_PRESENT,
X  CLI$_NEGATED,
X  CLI$_LOCPRES,
X  CLI$_DEFAULTED    : [EXTERNAL,VALUE] INTEGER;
X
XFunction CLI$DCL_PARSE(
X`009var command_string  : [CLASS_S,READONLY] PACKED ARRAY
X`009`009[$L1..$U1:INTEGER] OF CHAR;
X`009%immed table`009    : [READONLY] INTEGER;
X`009%immed [UNBOUND] procedure param_routine := %immed 0;
X`009%immed [UNBOUND] procedure prompt_routine := %immed 0;
X`009var prompt_string   : [CLASS_S,READONLY] PACKED ARRAY
X`009`009[$L2..$U2:INTEGER] OF CHAR:=%IMMED 0):INTEGER; EXTERNAL;
X
XFunction CLI$GET_VALUE(
X`009var entity_desc`009    : [CLASS_S,READONLY] PACKED ARRAY
X`009`009[$L1..$U1:INTEGER] OF CHAR;
X`009var retdesc`009    : [CLASS_S] PACKED ARRAY
X`009`009[$L2..$U2:INTEGER] OF CHAR;
X`009var retlength`009    : UWORD :=%IMMED 0):INTEGER;EXTERNAL;
X
XFunction CLI$PRESENT(
X`009var entity_desc`009    : [CLASS_S,READONLY] PACKED ARRAY
X`009`009[$L1..$U1:INTEGER] OF CHAR):INTEGER;EXTERNAL;
X
X
X(************   Start of mainline program **************)
XBEGIN
X`123
XFirst try to set this process to have CMKRNL,CMEXEC & SYSPRV - If we can't
Xdo this, the user has no right to run the program
X`125
XSETUP_PRIVS::PRV$TYPE.PRV$V_CMKRNL := TRUE;
XSETUP_PRIVS::PRV$TYPE.PRV$V_CMEXEC := TRUE;
XSETUP_PRIVS::PRV$TYPE.PRV$V_SYSPRV := TRUE;
X
XISTAT := $SETPRV(
X`009ENBFLG`009:= 1,
X`009PRVADR`009:= SETUP_PRIVS);
XIF ISTAT = SS$_NOTALLPRIV THEN $EXIT(SS$_NOPRIV);
XIF NOT ODD (ISTAT) THEN $EXIT(ISTAT);
X`123
XNow get the command from DCL which returns the new username
X`125
XISTAT := LIB$GET_FOREIGN(
X`009    GET_STR`009:= COMMAND_STRING.BODY,
X`009    USER_PROMPT`009:= 'Username: ',
X`009    OUT_LEN     := COMMAND_STRING.LENGTH);
XIF NOT ODD (ISTAT) THEN
X    IF ISTAT = RMS$_EOF THEN
X`009$EXIT(1) ELSE
X`009$EXIT(ISTAT);
X
XISTAT := CLI$DCL_PARSE(
X    'SETUNAME ' + SUBSTR(COMMAND_STRING.BODY,1,COMMAND_STRING.LENGTH),
X    %IMMED SETUNAMECLD);
XIF NOT ODD(ISTAT) THEN $EXIT;
X
XIF ODD(CLI$PRESENT('VERSION')) THEN
X    BEGIN
X    ISTAT := $GETMSG(SETUNAME_VERSION,ERRMSG.LENGTH,ERRMSG.BODY);
X    IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X    ERRMSG := ERRMSG + VER_STRING;
X    WRITELN(ERRMSG);
-+-+-+-+-+ End of part 13 +-+-+-+-+-