.title SETUP Some basic routines for AUTH_ID .ident /V1.00/ .sbttl Documentation ; ; This file contains several subroutines used for the ; AUTH_ID program. The subroutines are: ; ; SETUP Opens the input and output channels, opens the ; authorization file, finds out if this person ; is equipped with SYSPRV, sets some global flags ; if that is the case, and gathers some perliminary ; information about who can touch what IDs. ; ; FINIS closes all the files and exits ; ; CHECK_ACCESS checks to see if this person has the capability to ; control that identifier, or grant control of that ; identifier ; ; The following routines are based on similar routines in the ; run-time library: ; ; GET_INPUT is an input routine that gets its input from SYS$INPUT ; GET_COMMAND is an input routine that gets its input from SYS$COMMAND ; PUT_OUTPUT is an output routin that prints to SYS$OUTPUT ; .sbttl Macros, constants, etc .enable suppression ; clean up the listing file .disable traceback, debug ; hands off w/ da bugger .default displacement, word ; use only word-relative displacements recsiz == 8 ; size of records in IAF uic_key == 2 ; key position for UIC uic_key_size == 4 ; key size for UIC id_key == 1 ; key position for Identifier id_key_size == 4 ; key size for identifier rec_key == 0 ; key position for RECORD rec_key_size == recsiz ; size of record key uic_offset == 0 ; IAF file UIC offset id_offset == 4 ; IAF file ID offset get_input_minargs = 1 ; at last 1 param for input get_string = 4 ; descr for input param line prompt_string = 8 ; descr for prompt string out_len = 12 ; descr for output length get_input_mask = ^m ; save mask for input entries out_desc = 4 ; descriptor for output put_output_minargs = 1 ; min args for put_output flag_sysprv == 0 ; sysprv set flag mask_sysprv == 1 ; mask of above $jpidef ; declare GETJPI item codes $syidef ; declare GETSYI item codes $ssdef ; declare system service errors $rmsalldef ; declare ALL RMS codes, offsets $prvdef ; declare priv mask definitions .macro clrsp space, fill=#0 ; macro for clearing space subl space, sp ; on stack for a data area. movc5 #0, (sp), fill, - ; data area is init'd to space, (sp) ; nulls by this macro .endm clrsp ; that's it! .macro openfile, prefix, error ; macro for channel open $open fab='prefix'fab ; open channel to file blbc r0, error ; on error take this path $connect rab='prefix'rab ; connect record stream to file blbc r0, error ; on error take this path .endm openfile ; so much for opening the file .macro crefile, prefix, error ; macro for channel open and create fil $create fab='prefix'fab ; open channel to file blbc r0, error ; on error take this path $connect rab='prefix'rab ; connect record stream to file blbc r0, error ; on error take this path .endm crefile ; so much for opening the file .psect $pdata, noexe, nowrt, pic, shr, long input: .ascii /SYS$INPUT/ ; this is the input for commands input_len = . - input ; and its length .align long output: .ascii /SYS$OUTPUT/ ; here is where we write output output_len = . - output ; here is the output length .align long cmd: .ascii /SYS$COMMAND/ ; here is where we /CONFIRM prompt cmd_len = . - cmd ; ...and its length .align long prompt: .ascii /Do you want to create a new file? / prompt_len = . - prompt .psect $local, noexe, wrt, long, noshr, pic syilst: .word 4 ; length of buffer .word syi$_maxsysgroup ; item request code .address sysgrp ; write the code here .long 0, 0 ; length, item not needed jpilst: .word 4 ; length of buffer .word jpi$_uic ; request code -- get me the UIC .address uic ; write the UIC here .long 0 ; return len not needed .word 8 ; length of priv mask .word jpi$_procpriv ; request the current non elevated prvs .address privs ; write the priv mask there .long 0, jpi$c_listend ; item length not needed ; ; The above area is EXPENDABLE after SETUP completes. ; previd: ; use this locations for saving ids sysgrp: .long 0 ; write MAXSYSGRP sysgen param here saved: ; last boolean returned by CHECK_ACCESS privs: .long 0, 0 ; write privs here recbuf:: ; the IAF buffer is needed globally .blkb recsiz ; buffer for IAF file records uic:: ; UIC is a GLOBAL variable mem: .word 0 ; write UIC member here grp: .word 0 ; write UIC group here flags:: .long 0 ; control flags, if needed outfab: $fab fac=put, - ; write an output line fna=output, - ; use this as the output device fns=output_len, - ; this is the length of the name rat=cr, - ; carriage return carriage control rfm=var, - ; variable length format fop=cif ; if not there, create it outrab: $rab fab=outfab, - ; record attributes for the output: rop=eof ; open, access APPEND infab: $fab fac=get, - ; get an input line fna=input, - ; from the INPUT device fns=input_len ; this is its length inrab: $rab fab=infab ; no unusual record attribute for input ; ; for sys$command ; cmdfab: $fab fac=get, - ; get an input line fna=cmd, - ; from the SYS$COMMMAND device fns=cmd_len ; this is its length cmdrab: $rab fab=infab ; no unusual record attribute for input ; ; for the IAF file ; iaffab: $fab fac=, - ; allow all sorts of access to the IAF shr=, - ; allow others to get to it too fna=iafname, - ; this is the file name fns=iafname_len, - ; this is how long the name is org=idx, - ; this is an indexed file! fop=cif, - ; create-if-nonexistent rat=cr, - ; carriage return carriage control rfm=fix, - ; fixed length records mrs=recsiz, - ; this is the size of those records nam=iafnam, - ; associat this NAM w/ that FAB xab=iafxb0 ; point to the XAB chain for the IAF iafrab:: ; RAB is needed globally! $rab fab=iaffab, - ; associate the rab to this fab rac=key, - ; use indexed access rsz=recsiz, - ; records are this big usz=recsiz, - ; records are this big rbf=recbuf, - ; use this as the record buffer ubf=recbuf, - ; use this as the record buffer rop= ; no record locking, wait for locks iafnam: $nam ess=nam$c_maxrss ; give me the full file name iafxb0: $xabpro pro=, - ; set default protection on the file nxt=iafxb1 ; point to next XAB iafxb1: $xabkey ref=rec_key, - ; use whole rec as a primary key dtp=bn8, - ; type is unsigned quadword pos=0, - ; start here siz=recsiz, - ; end here -- no dups for this! nxt=iafxb2 ; go to next XAB iafxb2: $xabkey ref=id_key, - ; use ID as a secondary key pos=id_offset, - ; start of ID here siz=4, - ; 4 bytes (1 longword) long flg=dup, - ; allow duplicates dtp=bn4, - ; type is unsigned integer nxt=iafxb3 ; point to next XAB iafxb3: $xabkey ref=uic_key, - ; use UIC as third key pos=uic_offset, - ; primary is first field siz=4, - ; 4 bytes (1 longword) long flg=dup, - ; allow duplicates dtp=bn4 ; type is unsigned integer .psect $code, long, exe, pic, shr, nowrt .sbttl SETUP, main set-up loop .page .entry setup, ^m ; entry point SETUP clrsp #nam$c_maxrss ; make room for a name movl sp, r4 ; save a pointer to it bicl #3, sp ; longword align stack ptr movl r4, iafnam+nam$l_esa ; set pointer for error text $getsyiw_s itmlst=syilst ; get MAXSYSGRP blbc r0, 25$ ; on error get out $getjpiw_s itmlst=jpilst ; get privs and UIC blbc r0, 25$ ; on error get out cmpw sysgrp, grp ; are we a system user by UIC? blss 10$ ; if not, try next check bisl #mask_sysprv, flags ; set SYSPRV flag brb 30$ ; skip all other checks 10$: bbc #prv$v_sysprv, privs, 20$ ; real sysprv? and turned on? bisl #mask_sysprv, flags ; set SYSPRV flag brb 30$ ; skip disabling of SYSPRV 20$: $setprv_s enbflg=#0, - ; disable SYSPRV for OPEN prvadr=#prv$m_sysprv ; of TERMINAL files 25$: blbc r0, 35$ ; on error get out 30$: openfile in, 40$ ; open SYS$INPUT crefile out, 40$ ; open SYS$OUTPUT openfile cmd, 40$ ; open SYS$COMMAND $setprv_s enbflg=#1, - ; enable SYSPRV for opening prvadr=#prv$m_sysprv ; the IAF file and further work 35$: blbc r0, 40$ ; on error fubar out openfile iaf, retry ; open the IAF 40$: brw setend ; return with whatever status retry: movl sp, r5 ; save stack pointer pushl #0 ; RMS error has no params pushl r0 ; build error msg vector pushl r4 ; need the address of the file movzbl iafnam+nam$b_esl, -(sp) ; and length of the file name pushl #2 ; 2 arguments to the err msg pushl #iaf_nocando ; the error code itself pushl #6 ; six elements in vector movl sp, r0 ; save a pointer to the vector $putmsg_s msgvec=(r0) ; output the error bbc #flag_sysprv, flags, 10$ ; if nosysprv, exit now movl r5, sp ; restore stack pushal prompt ; find out about a new file pushl #prompt_len ; (use this prompt) pushl sp ; save the ptr to the descr calls #1, confirm ; ask about retrying blbs r0, 20$ ; on success create the file tstl r0 ; did we get an error back? bneq 10$ ; if not, error out movl #ss$_normal, r0 ; set success 10$: $exit_s code=r0 ; exit the program 20$: crefile iaf, setend ; create and open the file setend: clrl saved ; init SAVED to false clrl iafnam+nam$l_esa ; remove NAM block ptr ret ; return to caller .sbttl CHECK_ACCESS, Can this person really do that? .page ; ; This is the main "privilege check" routine for access to ; grant/remove/control identifiers. Simply pass (by value) ; The ID to check, and it'll look up in the IAF all IDs that ; This user has access to. ; minargs = 1 ; must have 1 argument id = 4 ; that is the ID .align long .entry check_access, ^m ; save R2 bbs #flag_sysprv, flags, 20$ ; if sysprv, always work cmpb #minargs, (ap) ; do we have all the args? bgtru 30$ ; if not, return last answer movl id(ap), r2 ; get the ID ;;; cmpl r2, previd ; same ID check as last time? ;;; beql 30$ ; if so, use same answer ;;; movl r2, previd ; This ID is now the prev-ID movb #rab$c_key, iafrab+rab$b_rac ; use access by KEY movb #rec_key, iafrab+rab$b_krf ; look at the ID as the key movb #rec_key_size, iafrab+rab$b_ksz ; use ID's size as the key siz movw #recsiz, iafrab+rab$w_usz ; set output buffer size moval recbuf, iafrab+rab$l_kbf ; use the rec buffer as the key movl uic, recbuf+uic_offset ; set UIC half movl r2, recbuf+id_offset ; set ID offset $get rab=iafrab ; get the record blbs r0, 20$ ; if it's there, give access cmpl #rms$_rnf, r0 ; is it "record not found?" beql 10$ ; if so, no access allowed pushl r0 ; something is wrong: signal calls #1, g^lib$signal ; ...error and fail 10$: clrl r0 ; set FALSE boolean clrl saved ; save the value ret ; go back to caller 20$: mnegl #1, r0 ; set TRUE boolean movl r0, saved ; save the value ret ; go back to caller 30$: movl saved, r0 ; return last answer ret ; go back to caller .sbttl FINIS, finish up and clean up .page .align long status = 4 ; the 1st arg on arg list .entry finis, ^m ; entry pt, save no regs movl #ss$_normal, r2 ; assume no args tstb (ap) ; any args? beql 10$ ; if not, don't worry about 'em movl status(ap), r2 ; get error 10$: $close fab=infab ; close input channel $close fab=outfab ; close output channel $close fab=cmdfab ; close command channel $exit_s code=r2 ; exit ret ; on error, return status .sbttl PUT_OUTPUT, put an output line to the terminal/file .page .align long .entry put_output, 0 ; entry PUT_OUTPUT, no regs cmpb (ap), #put_output_minargs ; did we get enough args? bgequ 10$ ; on error get out movzwl #ss$_insfarg, r0 ; set error status ret ; return 10$: movl out_desc(ap), r0 ; get descriptor address movw (r0), outrab+rab$w_rsz ; set descriptor length movl 4(r0), outrab+rab$l_rbf ; set address of where to write 15$: $put rab=outrab ; output the line ret ; return with status .sbttl GET_INPUT, GET_COMMAND, get input from terminal/command files .page .align long .entry get_input, get_input_mask ; entry point for GET_INPUT moval inrab, r11 ; input rab is set here brb input_code ; go to common code .align long .entry get_command, get_input_mask ; entry point for GET_COMMAND moval cmdrab, r11 ; command rab is set here input_code: ; -- common code joins here cmpb (ap), #get_input_minargs ; did we get enough arguments? bgequ 10$ ; if we got enough, skip this movzwl #ss$_insfarg, r0 ; set insufficient args ret ; and get out 10$: movl get_string(ap), r0 ; get the string descr movw (r0), rab$w_usz(r11) ; set the size of the inbuf movl 4(r0), rab$l_ubf(r11) ; set the address of it movc5 #0, (sp), #^a/ /, (r0), @4(r0) ; blank out the descriptor cmpb (ap), # ; did we get a prompt string? bgequ 15$ ; if so, load the values in clrl rab$l_pbf(r11) ; clear the buffer clrb rab$b_psz(r11) ; clear out its length bicl #rab$m_pmt, rab$l_rop(r11) ; clear the prompting option brb 20$ ; go on to common code 15$: movl prompt_string(ap), r0 ; get address of prompt descr movb (r0), rab$b_psz(r11) ; set length of prompt string movl 4(r0), rab$l_pbf(r11) ; set address of prompt string bisl #rab$m_pmt, rab$l_rop(r11) ; set prompting option 20$: $get rab=(r11) ; output the line ;;; blbc r0, 40$ ; on error then exit cmpb (ap), # ; did we get an output len buf blssu 40$ ; if not, simply return movw rab$w_rsz(r11), @out_len(ap) ; return output len buffer 40$: ret ; go back to caller .end ; that's it!