NetNews Usenet Archive 1992 #19/NN_1992_19.iso/spool/comp/os/vms/14419

Internet Message Format | 1992-09-01 | 14.3 KB

Path: sparky!uunet!cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!att!ucbvax!gwdgv1.dnet.gwdg.de!moeller
From: [e-mail] ("GWDGV1::MOELLER")
Newsgroups: comp.os.vms
Subject: REMPRTSMB 1.1 (VMS V5.5 fix) part 2 of 2
Message-ID: <[e-mail]>
Date: 31 Aug 92 21:49:52 GMT
Sender: [e-mail]
Organization: The Internet
Lines: 526

+-+-+-+ Beginning of part 2 +-+-+-+
X`009for(lp1 = optp; *lp1 != '\0'; lp1 = lp2) `123
X`009`009lp2 = strchr(lp1+1,'/');`009/* locate next '/' ... */
X`009`009if(lp2 == NULL) lp2 = lp1 + strlen(lp1);  /* ... or '\0' */
X
X#define opt_(o) ((lp2-lp1) == sizeof(o)-1 && strncmp(lp1,o,sizeof(o)-1) == 0)
X
X`009`009if(opt_("/USERNAME")) `123
X`009`009`009opt_username = 1;
X`009`009`125 else if(opt_("/JOBNAME")) `123
X`009`009`009opt_jobname = 1;
X`009`009`125 else if(opt_("/RSX")) `123
X`009`009`009opt_rsx = 1;
X`009`009`125 else if(opt_("/SPOOL")) `123
X`009`009`009opt_spool = 1;
X`009`009`125
X`009`125
X`009*optp = '\0';`009`009`009/* remove options now`009*/
X
X`009if(strlen(line) > (sizeof wap->wk_file)-39-1-39-1) `123
X`009`009return SS$_IVLOGNAM;`009/* make sure it's not too long */
X`009`125
X`009strcpy(wap->wk_file,line);`009/* copy "node::dev:[dir]"`009*/
X
X`009/*****`009filename`009*****/
X
X`009if(opt_jobname) `123`009`009/* have a try at JOB_NAME */
X`009`009int l1,l2;
X`009`009char c;
X
X`009`009line[0] = '\0';
X`009`009psm$read_item_dx(ctxp,&SMBMSG$K_JOB_NAME,&linedsc);
X`009`009line[itrmlen(&linedsc)] = '\0';
X
X`009`009l1 = 0; l2 = -1;
X`009`009for(lp = line; *lp; lp++) `123
X`009`009`009if(*lp == '.') `123
X`009`009`009`009if(l2 >= 0) goto job_name_failed;
X`009`009`009`009l2 = 0;
X`009`009`009`125 else if((*lp >= 'A' && *lp <= 'Z') `124`124
X`009`009`009`009  (*lp >= 'a' && *lp <= 'z') `124`124
X`009`009`009`009  (*lp >= '0' && *lp <= '9') `124`124
X`009`009`009`009  (!opt_rsx && (*lp == '_' `124`124
X`009`009`009`009`009`009*lp == '-' `124`124
X`009`009`009`009`009`009*lp == '$'))) `123
X`009`009`009`009if(l2 < 0) l1++; else l2++;
X`009`009`009`125 else goto job_name_failed;
X`009`009`125
X`009`009if(!opt_rsx) `123
X`009`009`009if(l1 == 0 `124`124 l1 > 39 `124`124
X`009`009`009   l2 == 0 `124`124 l2 > 39) goto job_name_failed;
X`009`009`125 else `123
X`009`009`009if(l1 == 0 `124`124 l1 > 9 `124`124
X`009`009`009   l2 == 0 `124`124 l2 > 3) goto job_name_failed;
X`009`009`125
X
X`009`009if(l2 < 0) strcat(line,".PRT");
X`009`009strcat(wap->wk_file,line);
X`009`009goto file_name_ok;
X`009`125
Xjob_name_failed:
X
X`009if(opt_username) `123`009`009`009/* "username.PRT" */
X`009`009line[0] = '\0';
X`009`009psm$read_item_dx(ctxp,&SMBMSG$K_USER_NAME,&linedsc);
X`009`009line[itrmlen(&linedsc)] = '\0';
X
X`009`009if(opt_rsx) `123
X`009`009`009if(strlen(line) > 9) line[9] = '\0';
X`009`009`009for(lp = line; *lp; lp++) `123
X`009`009`009`009if(!((*lp >= 'A' && *lp <= 'Z') `124`124
X`009`009`009`009     (*lp >= 'a' && *lp <= 'z') `124`124
X`009`009`009`009     (*lp >= '0' && *lp <= '9'))) `123
X`009`009`009`009`009*lp = '0';
X`009`009`009`009`125
X`009`009`009`125
X`009`009`125
X
X`009`009strcat(line,".PRT");
X`009`009strcat(wap->wk_file,line);
X`009`125 else `123`009`009`009`009/* "VAX.PRT" */
X`009`009strcat(wap->wk_file,"VAX.PRT");
X`009`125
Xfile_name_ok:
X
X`009wap->wk_fab.fab$b_fns = strlen(wap->wk_file);
X
X`009/*****`009spooling option`009*****/
X
X`009wap->wk_spool = opt_spool;
X
X`009/*****`009ready to go`009*****/
X
X`009wap->wk_scbp = *ctxp;
X`009wap->wk_state = open1;
X`009status = sys$dclast(rms_ast,&wap->wk_rab,0);
X`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X
X`009return PSM$_PENDING;
X`125
X
X/*****`009queue output`009*****/
X
Xstatic unsigned put_out(
X`009char **ctxp,
X`009WORKAREA *wap,
X`009char *bufp,
X`009unsigned short buflen)
X`123
X`009unsigned status;
X`009OUTPUTQELT *qp;
X
X
X`009qp = oq_alloc();
X`009qp->scbp = *ctxp;
X`009qp->op = bufp;
X`009qp->olen = buflen;
X`009status = lib$insqti(qp,&wap->wk_oqhead);
X`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X
X`009/* assume state=putting or =opened */
X
X`009if(wap->wk_state == opened) `123
X`009`009wap->wk_state = putting;
X`009`009status = sys$dclast(rms_ast,&wap->wk_rab,0);
X`009`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X`009`125
X
X`009return PSM$_PENDING;
X`125
X
X/*****`009abort job (asynch, no psm$report)`009*****/
X
Xstatic void abort_job(`009
X`009WORKAREA *wap)
X`123
X`009unsigned status;
X`009OUTPUTQELT *qp;
X`009static void rms_abort(WORKAREA *);`009`009/* forward */
X`009static void rms_open_cancel(WORKAREA *);`009/* forward */
X
X
X`009switch(wap->wk_state) `123
X`009  case putting:
X`009`009qp = oq_alloc();
X`009`009qp->scbp = NULL;
X`009`009qp->olen = OLEN_ABORT;
X`009`009status = lib$insqhi(qp,&wap->wk_oqhead);`009/* at HEAD */
X`009`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X`009`009break;
X
X`009  case opened:
X`009`009rms_abort(wap);
X`009`009break;
X
X`009  default:
X`009`009rms_open_cancel(wap);
X`009`009break;
X`009`125
X`125
X
X/*****`009 end of job`009*****/
X
Xstatic unsigned close_job(
X`009char **ctxp,
X`009WORKAREA *wap)
X`123
X`009unsigned status;
X`009OUTPUTQELT *qp;
X
X
X`009switch(wap->wk_state) `123
X`009  case putting:
X`009`009qp = oq_alloc();
X`009`009qp->scbp = *ctxp;
X`009`009qp->olen = OLEN_CLOSE;
X`009`009status = lib$insqti(qp,&wap->wk_oqhead);
X`009`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X`009`009break;
X
X`009  case opened:
X`009`009wap->wk_state = close1;
X`009`009wap->wk_scbp = *ctxp;
X`009`009status = sys$dclast(rms_ast,&wap->wk_rab,0);
X`009`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X`009`009break;
X`009`125
X`009return PSM$_PENDING;
X`125
X
X/*****`009initialize workarea (1st time only)`009*****/
X
Xstatic void init_wk(
X`009WORKAREA *wap)
X`123
X`009wap->wk_fab = cc$rms_fab;
X`009wap->wk_rab = cc$rms_rab;
X
X`009wap->wk_fab.fab$l_ctx = wap;
X        wap->wk_fab.fab$b_fac = FAB$M_PUT;
X#ifndef ASY_FAB
X`009wap->wk_fab.fab$l_fop = FAB$M_SQO `124 FAB$M_TEF;
X#else
X`009wap->wk_fab.fab$l_fop = FAB$M_ASY `124 FAB$M_SQO `124 FAB$M_TEF;
X#endif
X`009wap->wk_fab.fab$b_rfm = FAB$C_VAR;
X`009wap->wk_fab.fab$b_rat = 0;`009/* "none" */
X`009wap->wk_fab.fab$w_mrs = BLOCK_SIZE;
X`009wap->wk_fab.fab$l_fna = &wap->wk_file;
X`009/* b_fns to be filled in later, l_fop possibly modified */
X
X`009wap->wk_rab.rab$l_ctx = wap;
X`009wap->wk_rab.rab$l_fab = &wap->wk_fab;
X`009wap->wk_rab.rab$b_rac = RAB$C_SEQ;
X`009wap->wk_rab.rab$l_rop = RAB$M_ASY `124 RAB$M_WBH;
X`009/* l_rbf, w_rsz to be filled in later */
X
X`009wap->wk_state = closed;
X`125
X
X/*****`009cleanup OUTPUTQELTs in WORKAREA`009*****/
X
Xstatic void oq_cleanup(
X`009WORKAREA *wap)
X`123
X`009unsigned status;
X`009OUTPUTQELT *qp;
X
X
X`009/* the current qelt's scbp is NOT acknowledged !!! */
X
X`009if(wap->wk_curqp != NULL) `123`009
X`009`009oq_free(wap->wk_curqp);
X`009`009wap->wk_curqp = NULL;
X`009`125
X
X`009while((lib$remqhi(&wap->wk_oqhead, &qp) & 1) != 0) `123
X`009`009if(qp->scbp != NULL) `123
X`009`009`009psm$report(&qp->scbp,&0);`009/* fake completion */
X`009`009`125
X`009`009oq_free(qp);
X`009`125
X`125
X
X/** emergency (synch) close`009**/
X
Xstatic void rms_abort(
X`009WORKAREA *wap)
X`123
X`009unsigned fop,rop;
X
X
X`009if(wap->wk_fab.fab$w_ifi != 0) `123
X`009`009rop = wap->wk_rab.rab$l_rop;
X`009`009wap->wk_rab.rab$l_rop &= `126RAB$M_ASY;`009/* synch. $disconnect */
X`009`009fop = wap->wk_fab.fab$l_fop;
X`009`009wap->wk_fab.fab$l_fop `124= FAB$M_DLT;`009/* get rid of file */
X`009`009wap->wk_fab.fab$l_fop &= `126FAB$M_SPL;`009/* don't spool */
X#ifdef ASY_FAB
X`009`009wap->wk_fab.fab$l_fop &= `126FAB$M_ASY;`009/* synch. $close */
X#endif
X`009`009sys$close(&wap->wk_fab);`009`009/* ignore status */
X`009`009wap->wk_rab.rab$l_rop = rop;
X`009`009wap->wk_fab.fab$l_fop = fop;
X`009`125
X`009wap->wk_state=closed;
X`125
X
X/**`009AST for RMS actions, arg=pointer to RAB *or* FAB`009**/
X
Xstatic void rms_ast(
X`009struct RAB *frabp)`009/* bzw. struct FAB */
X`123
X`009unsigned status;
X`009WORKAREA *wap;
X
X
V`009wap = frabp->rab$l_ctx;`009/* same as fab$l_ctx - see old comments in .H
X */
X
X/** make sure "frabp" is used ONLY in the preceding line **/
X
Xagain:
X`009switch(wap->wk_state) `123
X
X`009/***********/
X`009  case closed:`009`009/* no-op */
X`009`009break;
X
X`009/***********/
X`009  case open1:
X`009  case open1t:
X
X`009`009if(wap->wk_spool) `123
X`009`009`009wap->wk_fab.fab$l_fop `124= FAB$M_SPL `124 FAB$M_DLT;
X`009`009`125 else `123
X`009`009`009wap->wk_fab.fab$l_fop &= `126(FAB$M_SPL `124 FAB$M_DLT);
X`009`009`125
X#ifndef ASY_FAB
X`009`009status=sys$create(&wap->wk_fab);`009/* synchronous`009*/
X#else
X`009`009/* asynch. $create */
X
X`009`009wap->wk_state = open2;
X
X`009`009status = sys$create(&wap->wk_fab,rms_ast,rms_ast);
X`009`009/* AST should take care of 'status', else bad luck ... */
X
X`009`009break;
X
X`009/***********/
X`009  case open2:
X`009`009status = wap->wk_fab.fab$l_sts;
X#endif
X`009`009if((status & 1) == 0) goto set_open_timer;
X
X`009`009/* asynch $connect`009*/
X
X`009`009wap->wk_state = open3;
X`009`009status = sys$connect(&wap->wk_rab,rms_ast,rms_ast);
X`009`009if((status & 1) == 0) `123
X`009`009`009rms_abort(wap);
X`009`009`009psm$report(&wap->wk_scbp,&status);
X`009`009`009return;
X`009`009`125
X`009`009break;
X
X`009/***********/
X`009  case open3:
X`009`009status = wap->wk_rab.rab$l_sts;
X`009`009if((status & 1) == 0) `123
X`009`009`009rms_abort(wap);
X`009`009`009psm$report(&wap->wk_scbp,&status);
X`009`009`009return;
X`009`009`125
X
X`009`009wap->wk_state = opened;
X`009`009psm$report(&wap->wk_scbp);
X`009`009break;
X
X`009/***********/
X`009  case putting:
X`009`009if(wap->wk_curqp != NULL) `123`009/* $put completion`009*/
X`009`009`009psm$report(&(wap->wk_curqp->scbp),
X`009`009`009`009`009&wap->wk_rab.rab$l_sts);
X`009`009`009oq_free(wap->wk_curqp);
X`009`009`125
X
X`009`009status = lib$remqhi(&wap->wk_oqhead, &wap->wk_curqp);
X`009`009if((status & 1) == 0) `123
X`009`009`009wap->wk_curqp = NULL;
X`009`009`009wap->wk_state = opened;
X`009`009`009return;
X`009`009`125
X
X`009`009switch(wap->wk_curqp->olen) `123
X`009`009  case OLEN_CLOSE:
X`009`009`009wap->wk_scbp = wap->wk_curqp->scbp;
X`009`009`009oq_cleanup(wap);
X`009`009`009wap->wk_state = close1;
X`009`009`009goto again;`009`009/* now do "close1" action */
X
X`009`009  case OLEN_ABORT:
X`009`009`009wap->wk_scbp = wap->wk_curqp->scbp;
X`009`009`009oq_cleanup(wap);
X`009`009`009wap->wk_state = aborting;
X`009`009`009goto again;`009`009/* now do "aborting" action */
X`009`009`125
X
X`009`009wap->wk_rab.rab$l_rbf = wap->wk_curqp->op;
X`009`009wap->wk_rab.rab$w_rsz = wap->wk_curqp->olen;
X`009`009status = sys$put(&wap->wk_rab,rms_ast,rms_ast);
X`009`009if((status & 1) == 0) `123
X`009`009`009psm$report(&(wap->wk_curqp->scbp),&status);
X`009`009`009rms_abort(wap);`009`009/* state -> closed */
X`009`009`009oq_cleanup(wap);`009/* cleanup */
X`009`009`125
X`009`009break;
X
X`009/***********/
X`009  case close1:
X`009`009wap->wk_state = close2;
X`009`009status = sys$disconnect(&wap->wk_rab,rms_ast,rms_ast);
X`009`009if((status & 1) == 0) `123
X`009`009`009rms_abort(wap);
X`009`009`009psm$report(&wap->wk_scbp,&status);
X`009`009`009return;
X`009`009`125
X`009`009break;
X
X`009/***********/
X`009  case close2:
X`009`009status = wap->wk_rab.rab$l_sts;
X`009`009if((status & 1) == 0) `123
X`009`009`009rms_abort(wap);
X`009`009`009psm$report(&wap->wk_scbp,&status);
X`009`009`009return;
X`009`009`125
X
X#ifndef ASY_FAB
X`009`009status = sys$close(&wap->wk_fab);`009/* synch.`009*/
X`009`009wap->wk_state = closed;
X#else
X`009`009wap->wk_state = close3;
X`009`009status = sys$close(&wap->wk_fab,rms_ast,rms_ast);
X`009`009if((status & 1) == 0) `123
X`009`009`009rms_abort(wap);
X`009`009`009psm$report(&wap->wk_scbp,&status);
X`009`009`009return;
X`009`009`125
X`009`009break;
X
X`009/***********/
X`009  case close3:
X`009`009status = wap->wk_fab.fab$l_sts;
X`009`009wap->wk_state = closed;`009`009`009/* it got to be ... */
X#endif
X`009`009psm$report(&wap->wk_scbp,&status);
X`009`009break;
X
X`009/***********/
X`009  case aborting:
X`009`009rms_abort(wap);
X`009`009if(wap->wk_scbp != NULL) `123`009`009/* only if desired */
X`009`009`009psm$report(&wap->wk_scbp,&0);
X`009`009`125
X`009`009break;
X
X`009/***********/
X`009  default:
X`009`009lib$stop(0x10000004,1,wap->wk_state);
X`009`009break;
X`009`125
X
X`009return;
X
Xset_open_timer:`009`009/* set timer & later retry $create */
X`009`123
X`009`009unsigned bintim[2];
X`009`009$DESCRIPTOR(timdsc,"0 0:2:0");
X
X`009`009sys$bintim(&timdsc,&bintim);
X
X`009`009wap->wk_state = open1t;
X`009`009status = sys$setimr(0,&bintim,rms_ast,&wap->wk_rab);
X`009`009if((status & 1) == 0) `123
X`009`009`009lib$stop(status `124 0x10000000);
X`009`009`125
X`009`125
X`125
X
X/**`009AST-subroutine: cancel open loop`009**/
X
Xstatic void rms_open_cancel(
X`009WORKAREA *wap)
X`123
X`009switch(wap->wk_state) `123
X
X`009  case open1t:
X`009`009sys$cantim(&wap->wk_rab,0);`009/* try to cancel timer`009*/
X`009  case open1:
X`009`009wap->wk_state = closed;`009`009/* no more open pending`009*/
X`009`009psm$report(&wap->wk_scbp,&0);`009`009/* open failed`009*/
X`009`009break;
X
X#ifdef ASY_FAB
X`009  case open2:
X#endif
X`009  case open3:
X`009`009wap->wk_state = aborting;`009/* no more open pending`009*/
X`009`009/* AST will call psm$report */
X`009`009break;
X`009`125
X`125
X
X/*****`009 allocate output q-element `009*****/
X
Xstatic OUTPUTQELT *oq_alloc(void)
X`123
X`009unsigned status;
X`009OUTPUTQELT *qp;
X
X
X`009if(oq_vm_zone == NULL) `123
X`009`009status = lib$create_vm_zone(&oq_vm_zone,
X`009`009`009`009&LIB$K_VM_FIXED,&sizeof(OUTPUTQELT));
X`009`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X`009`125
X
X`009status = lib$get_vm(&sizeof(OUTPUTQELT),&qp,&oq_vm_zone);
X`009if((status & 1) == 0) lib$stop(status `124 0x10000000);
X
X`009return qp;
X`125
X
X/*****/
X
X#ifdef OPTRACE
X
Xstatic unsigned opermsg(char *text)
X`123
X#include opcdef
X`009extern unsigned sys$sndopr(const DESCR *, unsigned);
X
X`009int l;
X`009struct `123
X`009`009unsigned func;
X`009`009unsigned rqstid;
X`009`009char buf[120];
X`009`125 opcbuf;
X`009DESCR bufdsc = `1230-0, DSC$K_DTYPE_T, DSC$K_CLASS_S, opcbuf`125;
X
X
X`009opcbuf.func = OPC$_RQ_RQST `124 (OPC$M_NM_CENTRL<<8);
X`009opcbuf.rqstid = 0;
X`009l = strlen(text);
X`009if(l > 120) l = 120;
X`009memcpy(opcbuf.buf,text,l);
X`009bufdsc.dsc$w_length = l + offsetof(struct opcbuf,buf);
X`009return sys$sndopr(&bufdsc,0);
X`125
X#endif
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 2 +-+-+-+-+-