+-+-+-+ Beginning of part 14 +-+-+-+ X $EXIT; X END; X XISTAT := CLI$GET_VALUE('P1',NEW_USERNAME); XIF NOT ODD(ISTAT) THEN $EXIT(ISTAT); X X`123 XNow set up the item list for the $GETUAI system service X`125 XWITH GETUAI_LIST[1] DO XBEGIN X BUFFER_LENGTH := SIZE(UIC); X ITEM_CODE`009 := UAI$_UIC; X BUFFER_ADDRESS := IADDRESS(UIC); X END; `032 X`123 XGet the poop on this new username from the UAF file X`125 XISTAT := $GETUAI( X USRNAM := NEW_USERNAME, X ITMLST := GETUAI_LIST); X`123 XIf we found one, do all the heavy work X`125 XIF ODD(ISTAT) THEN XBEGIN V LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY);`009`123 Disable CTRL/Y while in progre Xss `125 V LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY);`009`123 Disable CTRL/Y while in progre Xss `125 V SET_USERNAME(NEW_USERNAME);`009`009`123 Set the new username fields`009 X `125 V LIB$ENABLE_CTRL(LIB$M_CLI_CTRLY);`009`123 Re-enable control/y`009`009`032 X `125 X END ELSE X`123 XDidn't find one (or other system service error) print out Xan error msg X`125 XBEGIN X IF ISTAT = RMS$_RNF THEN X`009ISTAT := $GETMSG(SETUNAME_NOUSER,ERRMSG.LENGTH,ERRMSG.BODY) ELSE X`009ISTAT := $GETMSG(ISTAT,ERRMSG.LENGTH,ERRMSG.BODY); X IF NOT ODD(ISTAT) THEN $EXIT(ISTAT); X WRITELN(ERRMSG); X END; XEND. X $ GOSUB UNPACK_FILE $ FILE_IS = "SETUNAMECLD.CLD" $ CHECKSUM_IS = 1182532819 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X`009MODULE SETUNAMECLD X`009IDENT /V1.0/ X!+ X! This module define the syntax for the SETUNAME foreign command X!- X`009DEFINE SYNTAX SHOW_VERSION,NOPARAMETERS X X`009DEFINE VERB SETUNAME X`009`009PARAMETER P1 VALUE(REQUIRED) X`009`009QUALIFIER VERSION NONNEGATABLE,SYNTAX=SHOW_VERSION $ GOSUB UNPACK_FILE $ FILE_IS = "SETUNAMEMSG.MSG" $ CHECKSUM_IS = 1213993588 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X`009.FACILITY SETUNAME,1 X X`009.SEVERITY INFORMATIONAL X X`009VERSION X X`009.SEVERITY SUCCESS X`009BECAME /FAO=1 X X`009.SEVERITY FATAL X`009UAFNOTFOU X`009NOUSER`009 X`009.END $ GOSUB UNPACK_FILE $ FILE_IS = "SETUNAMESUB.MAR" $ CHECKSUM_IS = 1514344397 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X`009.TITLE SETUNAME_SUB X`009.IDENT /01.0/ X; X; This module has all the macro modules which support the BECOME program X; X; Revision history: X; X;`009V1.0 20-Aug-1989 X;`009`009Stolen from WEW's BECOME X; X; Include files: X; X`009.LIBRARY /SYS$LIBRARY:LIB/`009; Executive macro library X`009.LINK 'SYS$SYSTEM:SYS.STB'/SELECTIVE_SEARCH X X`009$PCBDEF`009`009`009`009; Process Control Block offsets X`009$JIBDEF`009`009`009`009; Job Information Block offsets X V;---------------------------------------------------------------------------- X--- X; X; Since this is a kernel mode routine R4 already points to the PCB X; of the current process X; X`009.PSECT`009CODE RD,NOWRT,PIC,EXE,LONG X`009.ENTRY`009SET_UIC `094M<>`009`009; Routine entry point X`009$CMKRNL_S ROUTIN=10$, -`009`009; Kick into kernel X`009`009 ARGLST=(AP)`009`009; & pass along the argument list X`009RET`009`009`009`009; back to the Pascal mainline X10$:`009.WORD 0`009`009`009`009; Kernel entry point X`009MOVAL`009HANDLER ,(FP)`009`009; Establish anti-crashing handler X`009MOVL`009@4(AP),PCB$L_UIC(R4)`009; Stuff the new UIC X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Set success X`009RET`009`009`009`009; from kernel X V;---------------------------------------------------------------------------- X--- X`009.ENTRY SET_USERNAME `094M ; Routine entry point X`009$CMKRNL_S ROUTIN=10$, -`009`009; Kick into kernel X`009`009 ARGLST=(AP)`009`009; & pass along the argument list X`009RET`009`009`009`009; back to the Pascal mainline X10$:`009.WORD`0090`009`009`009; Kernel entry point X`009MOVAL`009HANDLER, (FP)`009`009; Establish anti-crashing handler X`009MOVL`009PCB$L_JIB(R4),R0`009; Get JIB address X`009MOVC3`009#JIB$S_USERNAME,@4(AP),-; Copy the username X`009`009JIB$T_USERNAME(R0)`009; into the JIB X`009MOVC3`009#JIB$S_USERNAME,@4(AP),-; Copy the username X`009`009G`094CTL$T_USERNAME`009; into the CTL region X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Set success X`009RET`009`009`009`009; from kernel X V;---------------------------------------------------------------------------- X--- X`009.PSECT COND_HANDLER RD,NOWRT,PIC,EXE,LONG X`009.ENTRY`009HANDLER `094M<> X; X; First get the mutex count out of our PCB to see if we should X; release the I/O sub-system before exiting X; X`009MOVL`009G`094CTL$GL_PCB, R4`009; Get our current PCB X`009TSTW`009PCB$W_MTXCNT(R4)`009; Any mutex's held ? X`009BEQL`00910$`009`009`009; Branch if nope... X`009JSB`009G`094LNM$UNLOCK`009`009; Release our mutex X`009SETIPL`009#0`009`009`009; Drop our IPL to zero X10$:`009$EXIT_S`009`009`009`009; Cause process to exit X`009.END $ GOSUB UNPACK_FILE $ FILE_IS = "START-BBOARD.COM" $ CHECKSUM_IS = 872840685 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X$ Node = F$Trnlnm ("SYS$NODE") - "_" - "::" X$ If Node .NES. "SPCVXA" Then GoTo Exit X$ User`009 = F$GetJPI ("","USERNAME") X$ SetUName := $dua0:[bboard]SetUName X$ SetUName BBoard X$ If P1 .EQS. "WARM" Then GoTo No_Logicals X$ define/system/exec/nolog bboard_hook_name`009`009bboard X$ define/system/exec/nolog bboard_dir`009`009`009dua0:[bboard] X$ define/system/exec/nolog bboard_scratch_dir`009`009dua2:[bboard.scratch] X$ define/system/exec/nolog bboard_control_file`009bboard_dir:bboard.ctl X$ No_Logicals: X$ If p1 .eqs. "LOGICALS" Then GoTo Restore_User_Name X$ Run /Proc="BBoard_Daemon" - X`009/UIC=[BBOARD] - X`009/Input=Bboard_Dir:Run_BBoard_Daemon.com - X`009/Output=Bboard_Dir:bboard.out - X`009/Error=Bboard_Dir:bboard.err - X`009/Privilege=(SAME) - X`009/Priority=3 - X`009/Queue_Limit=32 - X`009Sys$System:Loginout X$ Restore_User_Name: X$ SetUName 'User' X$ Exit: $ GOSUB UNPACK_FILE $ FILE_IS = "SUPP.C" $ CHECKSUM_IS = 741437313 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X#include X#include X#include X#include X#include X#include X#include X#include "bboard.h" X X/* We've hit a fatal error. Print it, log it, tell OPCOM, then run away */ X Xvoid critical_error(char * err_line) X`123 X printf(err_line+2); X send_log_file(err_line); X send_opcom(err_line+2); X exit(SS$_ABORT); X`125 X X/* Intermediate error. Don't leave unless we're just starting up */ X Xvoid inter_error(char * log_flag, char * err_line, char * node, char * user) X`123 X char temp[256]; X X printf(err_line); X sprintf(temp, "%s%s", log_flag, err_line); X send_log_file(temp); X if (node) `123 `009`009`009/* Do we have someone to talk to? */ X`009send_msg(node, user, err_line); /* Yup, just tell them */ X `125 else `123 X`009send_opcom(err_line);`009`009/* Nope, must be start up, so tell */ X`009exit(SS$_ABORT);`009`009/* OPCOM then run screaming */ X `125 X`125 X X/* Build a String Descriptor for the passed string */ X Xvoid str_desc(struct dsc$descriptor * desc, char * str) X`123 X desc->dsc$a_pointer = str; X desc->dsc$w_length = strlen(str); X desc->dsc$b_dtype = DSC$K_DTYPE_T; X desc->dsc$b_class = DSC$K_CLASS_S; X`125 X X/* Destroy all non-isgraph() characters */ X Xchar * strip(char * s) X`123 X register char * so; X register char * si; X X for (si = so = s; *si; si++) `123 X`009if (isgraph(*si)) `123 X`009 *so++ = *si; X`009`125 X `125 X *so = '\0'; X return s; X`125 X X/* Terminate a string after last non-blank character */ X Xchar * trim_end(char * s) X`123 X register char * si; X X for (si = s+strlen(s)-1; isspace(*si) && (si >= s); si--); X *(++si) = '\0'; X`125 X X/* Convert "\t" to " " and " " to " ". Also, lose initial and X trailing blanks */ X Xchar * scrunch(char * s) X`123 X register char * si; X register char * so; X X for (si = s; *si && (*si == ' ' `124`124 *si == '\t'); si++); X X for (so = s; *si; si++) `123 X`009if (*si == '\t') `123 X`009 *si = ' '; X`009`125 X`009if (*si == ' ' && *(si+1) == ' ') `123 X`009 continue; X`009`125 X`009*so++ = *si; X `125 X *so = '\0'; X X trim_end(s); X X return (s); X`125 X X/* Upper-case a string */ X Xchar * strupr(char * s) X`123 X register char *si; X X for (si = s; *si; si++) `123 X`009*si = toupper(*si); X `125 X return s; X`125 X X/* Lower-case a string */ X Xchar * strlwr(char * s) X`123 X register char * si; X X for (si = s; *si; si++) `123 X`009*si = tolower(*si); X `125 X return s; X`125 X X/* Strip '"' from a string */ X Xchar * remove_quotes(char * s) X`123 X register char * si; X register char * so; X X for (so = si = s; *si; si++) `123 X`009if (*si == '"') `123 X`009 continue; X`009`125 X`009*so++ = *si; X `125 X *so = '\0'; X return(s); X`125 X X/* Some wierd time handling routines... */ X X/* Fill a SYSTIM buffer (long[2]) */ X Xlong * get_time(long * buf) X`123 X sys$gettim(buf); X return(buf); X`125 X X/* Use SYS$NUMTIM to convert a SYSTIM to the parsed-out NUMTIM format */ X Xstruct $NUMTIM * get_numtim(struct $NUMTIM * num, long * buf) X`123 X sys$numtim(num, buf); X return (num); X`125 X X/* Figure out the start and end dates for a particular interval */ X Xlong * start_end_time(char delt_type, long * buf_start, long * buf_end) X`123 X long delt;`009`009`009`009/* Delta time (sort of) */ X long op;`009`009`009`009/* Operation to do (passed by ref) */ X SYSTIM temp_time;`009`009`009/* Temporary time buffer */ X struct $NUMTIM t_numtim;`009`009/* NUMTIM buffer for Months */ X X switch (delt_type) `123`009`009/* What kind of interval? */ X X /* Build a week */ X`009case 'w': X`009case 'W': X X`009 /* We need to find out the current day of week */ X X`009 op = LIB$K_DAY_OF_WEEK; X X`009 /* Ask LIB$ to stuff it in delt */ X X`009 lib$cvt_from_internal_time(&op, &delt, buf_start); X X`009 /* Our weeks start on Sunday */ X X`009 if (delt != 7L) `123`009`009/* If it's not Sunday, adjust it */ X`009`009op = LIB$K_DELTA_DAYS; X`009`009lib$cvt_to_internal_time(&op, &delt, temp_time); X`009`009lib$sub_times(buf_start, temp_time, buf_start); X`009 `125 X X`009 /* Now let's find out the beginning of the next period */ X X`009 op = LIB$K_DELTA_WEEKS; X`009 delt = 1L; X`009 lib$cvt_to_internal_time(&op, &delt, temp_time); X`009 lib$add_times(buf_start, temp_time, buf_end); X`009 break; X X /* Build a month */ X`009case 'm': X`009case 'M': X X`009 /* We need to find out the current day of the month */ X X`009 op = LIB$K_DAY_OF_MONTH; X X`009 /* Ask LIB$ to stuff it in delt */ X X`009 lib$cvt_from_internal_time(&op, &delt, buf_start); X X`009 /* If we're not on day 1 of the month, find the beginning */ X X`009 if (--delt) `123 X`009`009op = LIB$K_DELTA_DAYS; X`009`009lib$cvt_to_internal_time(&op, &delt, temp_time); X`009`009lib$sub_times(buf_start, temp_time, buf_start); X`009 `125 X X`009 /* Convert the beginning of the month to NUMTIM format */ X X`009 sys$numtim(&t_numtim, buf_start); X X`009 /* Now let's go forward a month */ X X`009 if (++t_numtim.month > 12) `123 X`009`009t_numtim.month = 1;`009/* Crossed a year boundary */ X`009`009t_numtim.year++; X`009 `125 X X`009 /* But we want it back in SYSTIM format */ X X`009 lib$cvt_vectim(&t_numtim, buf_end); X`009 break; X `125 X V /* Now that we have the current beginning and the beginning of the next * X/ V /* period, we need to find the current end by subtracting one day from * X/ X /* the next beginning. */ X X delt = 1L; X op = LIB$K_DELTA_DAYS; X lib$cvt_to_internal_time(&op, &delt, &temp_time); X lib$sub_times(buf_end, temp_time, buf_end); X X /* And we're all done. Whew! */ X X return (buf_start); X`125 X X/* Read a \n delimited string and convert the \n to a \0. X Also, perform tab expansion */ X Xstatic char * detab(char * s); X Xint fgets_lcl(char * s, int len, FILE * f) X`123 X char * t_status; X X /* First, let's actually read the line */ X X t_status = fgets(s, len, f); X X /* If it worked, we got back (s) */ X X if (t_status) `123 X`009s[strlen(s)-1] = '\0'; /* Replace \n with \0 */ X`009detab(s);`009`009`009/* And expand tabs */ X `125 else `123 X`009s[0] = '\0'; /* Error. Zap the string */ X `125 X return (int) t_status;`009`009/* And let them know what happened */ X`125 X X/* Expand all '\t' characters to the correct number of spaces */ X Xstatic char * detab(char * s) X`123 X char * so; X char * si; X int i; X X so = xmalloc(512);`009`009`009/* Hopefully this will be big enough */ X V for (si = s, i = 0; *si; si++) `123`009/* Scan through the input string * X/ X`009if (*si != '\t') `123 /* If it's not a tab, just copy it */ X`009 so[i++] = *si; X`009 continue; X`009`125 X`009so[i++] = ' '; /* That's at least one space */ X`009for (; i & 7; i++) `123`009`009/* Now just keep going until we've */ X`009 so[i] = ' '; /* written to the next multiple of 8 */ X`009`125 X `125 X so[i] = '\0'; /* Terminate the string (finally) */ X strcpy(s, so);`009`009`009/* Copy it back */ X xfree(so);`009`009`009`009/* And release some storage */ X X return (s); X`125 X X/* Replacements for malloc() and free() for direct VMS virtual memory X support X*/ X X X#define LIB$K_VM_FIRST_FIT`0091 X#define LIB$K_VM_QUICK_FIT`0092 X#define LIB$K_VM_FREQ_SIZES`0093 X#define LIB$K_VM_FIXED`009`0094 X#define LIB$M_VM_BOUNDARY_TAGS`0091 X#define LIB$M_VM_GET_FILL0`0092 X#define LIB$M_VM_GET_FILL1`0094 X#define LIB$M_VM_FREE_FILL0`0098 X#define LIB$M_VM_FREE_FILL1`00916 X#define LIB$M_VM_EXTEND_AREA`00932 X Xstatic unsigned zone_id = 0; X Xvoid * xmalloc(unsigned size) X`123 X static unsigned zone_init = FALSE; X static unsigned alloc_type; X static unsigned alloc_arg; X static unsigned alloc_flags; X X void * base; X int status; X X if (!zone_init) `123`009`009`009/* first time through? */ X`009alloc_type = LIB$K_VM_QUICK_FIT; X`009alloc_arg = 8; X`009alloc_flags = LIB$M_VM_BOUNDARY_TAGS `124 LIB$M_VM_GET_FILL0 `124 X`009`009LIB$M_VM_FREE_FILL0; X`009status = lib$create_vm_zone(&zone_id, &alloc_type, &alloc_arg, X`009`009&alloc_flags, 0, 0, 0, 0, 0, 0); X`009zone_init = TRUE; X`009if (!(status & 1)) `123 X`009 report_error("Create_Vm_Zone", status); X`009`125 X `125 X X status = lib$get_vm(&size, &base, &zone_id); X if (!(status & 1)) `123 X`009report_error("Lib$Get_Vm failed", status); X `125 X X return(base); X`125 X Xvoid xfree(void * mem) X`123 X int status; X X status = lib$free_vm(0, &mem, &zone_id); X if (!(status & 1)) `123 X`009report_error("Lib$Free_Vm failed", status); X `125 X`125 $ GOSUB UNPACK_FILE -+-+-+-+-+ End of part 14 +-+-+-+-+-