module setown (main = go, ident = '01') = begin !++ ! ! Set owner on a file, with wild carding. ! ! Neal Lippman, 8/10/80 ! !-- library 'sys$library:lib'; literal true = 1, false = 0; macro descriptor [] = uplit long(word(%charcount(%string(%remaining)),0), uplit byte(%string(%remaining))) %, tell [] = ( external routine lib$put_output : addressing_mode(absolute); lib$put_output(descriptor(%remaining)) )% ; bind wildstring = uplit byte('*.*'); own filename : vector[63,byte], file_len : word, xab : block[xab$c_prolen,byte], !xab for protection res_name : vector [nam$c_maxrss, byte], !resultant name exp_name : vector [nam$c_maxrss, byte], !expanded name nam_block : $nam ( !name block rsa = res_name, !result name addr rss = nam$c_maxrss, !result name size esa = exp_name, !expanded name addr ess = nam$c_maxrss), !exanded name size fab : $fab( dna=wildstring, !wild card everything dns=3, fac=, !need write access to set prot fna=filename, !put filename here fop=nam, !name block open nam=nam_block, !name block for search and parse xab=xab ), file_desc : vector[2,long] initial(63,filename), me_grp : word, me_mbm : word, grp : word, mbm : word, jpi_list : vector[7,long] initial( word(2,jpi$_grp),me_grp,0, word(2,jpi$_mem),me_mbm,0,0); forward routine get_own : novalue, go; external routine str$upcase : addressing_mode(general), lib$get_input : addressing_mode(absolute); routine go = ( local istat, got_own : byte; got_own = false; xab[xab$b_cod] = xab$c_pro; !make us a protection xab xab[xab$b_bln] = xab$c_prolen; !and set its length xab[xab$w_grp] = 0; xab[xab$w_mbm] = 0; xab[xab$l_nxt] = 0; $getjpi(itmlst = jpi_list); while true do ( !get the file name lib$get_input(file_desc,descriptor(' File(s): '),file_len); if .file_len eql 0 then return 1; !exit if no file spec fab[fab$b_fns] = .file_len<0,8>; istat = $rms_parse (fab = fab); !parse the file spec if not .istat then ( tell('%Error parsing file specification'); return .istat !exit to system with error code ); if .got_own eql true then ( local ans : byte, desc : vector[2,long]; desc[0] = 1; desc[1] = ans; lib$get_input(desc,descriptor('Use same owner [Y/N]? ')); if (.ans geq %c'a') and (.ans leq %c'z') then ans = .ans -%x'20'; if .ans neq %c'Y' then got_own = false ); while true do !loop through all files... ( istat = $rms_search (fab = fab); !search for file if .istat eql rms$_nmf then exitloop; !no more files? if not .istat then !some other error? ( tell ('%Error searching for file'); return .istat ); if .got_own eql false then !get the owner if we don't !have one for this file spec ( get_own(); got_own = true ); istat = $rms_open(fab = fab); !open the file if .istat neq rms$_normal then ( tell ('%Error opening file'); return .istat ); !close the file, setting owner xab[xab$w_grp] = ( if .grp eql 0 then .me_grp else .grp); xab[xab$w_mbm] = ( if .mbm eql 0 then .me_mbm else .mbm); istat = $rms_close(fab = fab); if .istat neq rms$_normal then ( tell ('%Error closing file'); return .istat ); if not .nam_block [nam$v_wildcard] then exitloop; ); !end of search loop ); !end of main loop 1 ); !end of the routine routine get_own : novalue = ( ! !get the owner uic ! local istat, own_len : word, desc : vector[2,long], string : vector[3,byte]; external routine ots$cvt_to_l : addressing_mode(absolute); desc[0] = 3; desc[1] = string; lib$get_input(desc,descriptor(' Group: '),own_len); desc[0] = .own_len; if (istat = ots$cvt_to_l(desc,grp,2)) neq ss$_normal then $exit(code = .istat); desc[0] = 3; lib$get_input(desc,descriptor(' Member: '),own_len); desc[0] = .own_len; if (istat = ots$cvt_to_l(desc,mbm,2)) neq ss$_normal then $exit(code = .istat); return ); end eludom