ozb~ XCOPY.BCKа XCOPY.BCK,BACK/GROUP=0 *.*/EXCL=*.OBJ [-]XCOPY.BCK/SAV SYSTEM v}V5.3 _BATMAN::  _$1$DUA7: V5.3 ~ *[SRC.XCOPY]XCOPY.C;1+,UB.3/ 4O31-TB0123KPWO256നݐΓ7@H}8 %Mϧ9GHJb/*' * XCOPY.C - copy files block by block.6 * Copyright (C) Nick Brown 1989. All rights reserved. */#include stdio #include fab #include rab #include xab #include nam#include rmsdef#include devdef#include climsgdef#include ssdef#include descrip/*A * The next declaration allows us to access external VMS symbols. */typedef int EXTERNAL ();/*- * Possible responses to confirmation prompt. */#define OK_NO 0#define OK_YES 1#define OK_ALL 2#define OK_QUIT 3/*. * Names of the DCL symbols we set on failure. */4$DESCRIPTOR(block_symbol_des, "XCOPY_FAILED_BLOCK");2$DESCRIPTOR(file_symbol_des, "XCOPY_FAILED_FILE");#define SYMBOL_TABLE 1/*A * The number of blocks we copy in each RMS read/write operation. */#define RMS_IOSIZE_MIN 1#define RMS_IOSIZE_DEFAULT 4#define RMS_IOSIZE_MAX 127#define DISK_BLOCKSIZE 512#define MAX_BUFFER 65535/*@ * The number of trace messages, if no value is given on /TRACE. */#define NTRACES 10/*9 * Filespec used as default when parsing output filename. */#define HERE "SYS$DISK:[]*.*"/*A * Variables that match CLI parameters, and so have to be global.< * These are recognisable by their capitalised first letter. */static int Log;static int Trace;static int Confirm;static int Interval;static int Interval_seen;static int First_block;static int New_file;static int Last_block;static int Last_block_seen;static int Rms_iosize;main (argc, argv) int argc; char *argv [];{ static struct FAB input_fab; static struct NAM input_nam;$ static struct XABFHC input_xabfhc; static struct FAB output_fab; static struct NAM output_nam;% static struct XABFHC output_xabfhc;( struct FAB *input_fabptr = &input_fab;( struct NAM *input_namptr = &input_nam;1 struct XABFHC *input_xabfhcptr = &input_xabfhc;* struct FAB *output_fabptr = &output_fab;* struct NAM *output_namptr = &output_nam;3 struct XABFHC *output_xabfhcptr = &output_xabfhc; char input_expname [255]; char input_resname [255]; char input_defname [255]; char input_filename [255]; char output_expname [255]; char output_resname [255]; char output_defname [255]; char output_filename [255]; char value [255]; char infile [255]; char outfile [255]; int start_filenum; int actual_filenum; int first_filespec; int quit; int output_dir_wild;/*# * Get the command line parameters. */( if (my_present("P1") == CLI$_ABSENT) {' panic("get_args: no parameter P1"); }) if (my_present("P2") == CLI$_PRESENT) {5 if (my_get_value("P2", outfile) == CLI$_ABSENT) {) panic("get_args: problem with P2"); } } else {' panic("get_args: no parameter P2"); } First_block = 0;2 if (my_present("FIRST_BLOCK") == CLI$_PRESENT) {; if (my_get_value("FIRST_BLOCK", value) != SS$_NORMAL) {3 panic("get_args: problem with /FIRST_BLOCK"); }& sscanf(value, "%d", &First_block); } New_file = (First_block == 0); if (New_file) { First_block = 1; } Last_block_seen = 0; Last_block = 0x7fffffff;1 if (my_present("LAST_BLOCK") == CLI$_PRESENT) {: if (my_get_value("LAST_BLOCK", value) != SS$_NORMAL) {2 panic("get_args: problem with /LAST_BLOCK"); }% sscanf(value, "%d", &Last_block); Last_block_seen = 1; } start_filenum = 1;0 if (my_present("WILD_FILE") == CLI$_PRESENT) {9 if (my_get_value("WILD_FILE", value) != SS$_NORMAL) {1 panic("get_args: problem with /WILD_FILE"); }( sscanf(value, "%d", &start_filenum); } Log = 0;* if (my_present("LOG") == CLI$_PRESENT) { Log = 1; } Confirm = 0;. if (my_present("CONFIRM") == CLI$_PRESENT) { Confirm = 1; } Trace = 0; Interval_seen = 0;, if (my_present("TRACE") == CLI$_PRESENT) { Log = 1; Trace = 1;5 if (my_get_value("TRACE", value) == SS$_NORMAL) {% sscanf(value, "%d", &Interval); Interval_seen = 1; } }" Rms_iosize = RMS_IOSIZE_DEFAULT;1 if (my_present("RMS_IOSIZE") == CLI$_PRESENT) {: if (my_get_value("RMS_IOSIZE", value) != SS$_NORMAL) {2 panic("get_args: problem with /RMS_IOSIZE"); }% sscanf(value, "%d", &Rms_iosize); }$ if (Rms_iosize < RMS_IOSIZE_MIN) { Rms_iosize = RMS_IOSIZE_MIN; }$ if (Rms_iosize > RMS_IOSIZE_MAX) { Rms_iosize = RMS_IOSIZE_MAX; }/*& * Set up the FABs and related blocks.F * We assume that fields that must be zero already are zero (since the3 * blocks will be allocated in demand zero pages). */& input_fabptr->fab$b_bid = FAB$C_BID;& input_fabptr->fab$b_bln = FAB$C_BLN;2 input_fabptr->fab$b_fac = FAB$M_BIO | FAB$M_GET;& input_fabptr->fab$b_shr = FAB$M_UPI; input_fabptr->fab$w_ifi = 0;+ input_fabptr->fab$l_fna = input_filename;& input_fabptr->fab$l_fop = FAB$M_NAM;) input_fabptr->fab$l_nam = input_namptr;, input_fabptr->fab$l_xab = input_xabfhcptr;* input_fabptr->fab$l_dna = input_defname; input_fabptr->fab$b_dns = 0;" input_fabptr->fab$b_acmodes = 0;& input_namptr->nam$b_bid = NAM$C_BID;& input_namptr->nam$b_bln = NAM$C_BLN;* input_namptr->nam$l_esa = input_expname;2 input_namptr->nam$b_ess = sizeof(input_expname);* input_namptr->nam$l_rsa = input_resname;2 input_namptr->nam$b_rss = sizeof(input_resname); input_namptr->nam$l_rlf = 0;, input_xabfhcptr->xab$b_bln = XAB$C_FHCLEN;) input_xabfhcptr->xab$b_cod = XAB$C_FHC;! input_xabfhcptr->xab$l_nxt = 0;' output_fabptr->fab$b_bid = FAB$C_BID;' output_fabptr->fab$b_bln = FAB$C_BLN;3 output_fabptr->fab$b_fac = FAB$M_BIO | FAB$M_PUT;' output_fabptr->fab$b_shr = FAB$M_NIL; output_fabptr->fab$w_ifi = 0;- output_fabptr->fab$l_fna = output_filename; output_fabptr->fab$l_fop = 0;+ output_fabptr->fab$l_nam = output_namptr;. output_fabptr->fab$l_xab = output_xabfhcptr;, output_fabptr->fab$l_dna = output_defname;# output_fabptr->fab$b_acmodes = 0;- output_xabfhcptr->xab$b_bln = XAB$C_FHCLEN;* output_xabfhcptr->xab$b_cod = XAB$C_FHC;" output_xabfhcptr->xab$l_nxt = 0;' output_namptr->nam$b_bid = NAM$C_BID;' output_namptr->nam$b_bln = NAM$C_BLN;, output_namptr->nam$l_esa = output_expname;4 output_namptr->nam$b_ess = sizeof(output_expname);, output_namptr->nam$l_rsa = output_resname;4 output_namptr->nam$b_rss = sizeof(output_resname); output_namptr->nam$l_rlf = 0; first_filespec = 1; quit = 0;B while ((my_get_value("P1", infile) != CLI$_ABSENT) && (!quit)) { struct NAM old_input_nam;2 struct NAM *old_input_namptr = &old_input_nam;, strcpy(input_fabptr->fab$l_fna, infile);> input_fabptr->fab$b_fns = strlen(input_fabptr->fab$l_fna);/*. * Split out the fields of the input filename. */+ input_namptr->nam$b_nop = NAM$M_SYNCHK;" sys$parse(input_fabptr, 0, 0);- if ((input_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_parsein; lib$stop(xcopy_parsein, 2,@ input_fabptr->fab$b_fns, input_fabptr->fab$l_fna,( input_fabptr->fab$l_sts); }/*L * If this is the second or subsequent filespec, apply defaults from before. */ if (!first_filespec) {* if (input_namptr->nam$b_node == 0) {F memcpy(input_namptr->nam$l_node, old_input_namptr->nam$l_node,J (input_namptr->nam$b_node = old_input_namptr->nam$b_node)); }) if (input_namptr->nam$b_dev == 0) {D memcpy(input_namptr->nam$l_dev, old_input_namptr->nam$l_dev,H (input_namptr->nam$b_dev = old_input_namptr->nam$b_dev)); }) if (input_namptr->nam$b_dir == 0) {D memcpy(input_namptr->nam$l_dir, old_input_namptr->nam$l_dir,H (input_namptr->nam$b_dir = old_input_namptr->nam$b_dir)); }* if (input_namptr->nam$b_name == 0) {F memcpy(input_namptr->nam$l_name, old_input_namptr->nam$l_name,J (input_namptr->nam$b_name = old_input_namptr->nam$b_name)); }* if (input_namptr->nam$b_type == 0) {F memcpy(input_namptr->nam$l_type, old_input_namptr->nam$l_type,J (input_namptr->nam$b_type = old_input_namptr->nam$b_type)); } }/*- * Remember the defaults for next time round. */? memcpy(old_input_namptr, input_namptr, sizeof(struct NAM));/*> * Now rebuild the input filename using the previous defaults. */, build_filename(&input_fabptr->fab$b_dns,; input_fabptr->fab$l_dna, input_namptr); input_namptr->nam$b_nop = 0;" sys$parse(input_fabptr, 0, 0);- if ((input_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_parsein; lib$stop(xcopy_parsein, 2,@ input_fabptr->fab$b_fns, input_fabptr->fab$l_fna,( input_fabptr->fab$l_sts); }/*G * Split out the fields of the output filename, using a simple default. */. strcpy(output_fabptr->fab$l_fna, outfile);@ output_fabptr->fab$b_fns = strlen(output_fabptr->fab$l_fna);+ strcpy(output_fabptr->fab$l_dna, HERE);@ output_fabptr->fab$b_dns = strlen(output_fabptr->fab$l_dna);, output_namptr->nam$b_nop = NAM$M_SYNCHK;# sys$parse(output_fabptr, 0, 0);. if ((output_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_parseout;! lib$stop(xcopy_parseout, 2,B output_fabptr->fab$b_fns, output_fabptr->fab$l_fna,) output_fabptr->fab$l_sts); }/*L * Remove wildcards from output filespec (we use input filespec as default). */ output_dir_wild = 0;4 if (output_namptr->nam$l_fnb & NAM$M_WILD_DIR) {# output_namptr->nam$b_dir = 0; output_dir_wild = 1; }5 if (output_namptr->nam$l_fnb & NAM$M_WILD_NAME) {$ output_namptr->nam$b_name = 0; }5 if (output_namptr->nam$l_fnb & NAM$M_WILD_TYPE) {$ output_namptr->nam$b_type = 0; }4 if (output_namptr->nam$l_fnb & NAM$M_WILD_VER) {# output_namptr->nam$b_ver = 0; }- build_filename(&output_fabptr->fab$b_fns,= output_fabptr->fab$l_fna, output_namptr); actual_filenum = 0; while (1) {% sys$search(input_fabptr, 0, 0);0 if (input_fabptr->fab$l_sts == RMS$_NMF) { break; }4 else if ((input_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_openin;! lib$stop(xcopy_openin, 2,B input_namptr->nam$b_esl, input_namptr->nam$l_esa,* input_fabptr->fab$l_sts); }/*E * If necessary, skip the first few files of the input specification. */- if (++actual_filenum < start_filenum) { continue; }6 create_symbol(&file_symbol_des, actual_filenum);E create_symbol(&block_symbol_des, (New_file ? 0 : First_block));< if (quit = copy_one_file(actual_filenum, input_fabptr,A output_fabptr, output_dir_wild)) { --actual_filenum; break; }: create_symbol(&file_symbol_des, actual_filenum + 1);* create_symbol(&block_symbol_des, 0); First_block = 1; New_file = 1; }/*& * End of processing for one filespec. */ first_filespec = 0; }6 create_symbol(&file_symbol_des, actual_filenum + 1);& create_symbol(&block_symbol_des, 0);}/*E * Function to copy one file. Return 1 if the user quits the program.= * On input, filenum is the number within the input wildcard. */Ecopy_one_file (filenum, input_fabptr, output_fabptr, output_dir_wild) int filenum; struct FAB *input_fabptr; struct FAB *output_fabptr; int output_dir_wild;{ int start_block; int end_block; int blocks_per_io; int blocksize; int file_allocation; static struct RAB input_rab; static struct RAB output_rab; char file_buffer [MAX_BUFFER];( struct RAB *input_rabptr = &input_rab;5 struct NAM *input_namptr = input_fabptr->fab$l_nam;; struct XABFHC *input_xabfhcptr = input_fabptr->fab$l_xab;* struct RAB *output_rabptr = &output_rab;7 struct NAM *output_namptr = output_fabptr->fab$l_nam;= struct XABFHC *output_xabfhcptr = output_fabptr->fab$l_xab;& input_rabptr->rab$b_bid = RAB$C_BID;& input_rabptr->rab$b_bln = RAB$C_BLN;) input_rabptr->rab$l_fab = input_fabptr;( input_rabptr->rab$l_bkt = First_block;( input_rabptr->rab$l_ubf = file_buffer; input_rabptr->rab$l_xab = 0; input_rabptr->rab$l_rop = 0;' output_rabptr->rab$b_bid = RAB$C_BID;' output_rabptr->rab$b_bln = RAB$C_BLN;+ output_rabptr->rab$l_fab = output_fabptr;) output_rabptr->rab$l_rbf = file_buffer; output_rabptr->rab$l_xab = 0; output_rabptr->rab$l_rop = 0;/*D * If the input or output file name contains a node name, remove theM * node name, device, directory, and version number from the resultant input. * file name before applying it as a default.9 * Otherwise, use the resultant input file specification.I * Exception: if we had a wildcard in our DCL output file directory spec,) * use the input directory as a default. */0 if ( (input_namptr->nam$l_fnb & NAM$M_NODE)1 || (output_namptr->nam$l_fnb & NAM$M_NODE) ) {! input_namptr->nam$b_node = 0; input_namptr->nam$b_dev = 0; if (!output_dir_wild) {" input_namptr->nam$b_dir = 0; } input_namptr->nam$b_ver = 0; }+ build_filename(&output_fabptr->fab$b_dns,: output_fabptr->fab$l_dna, input_namptr);/*' * Find the definitive target filename. */ output_namptr->nam$b_nop = 0;! sys$parse(output_fabptr, 0, 0);, if ((output_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_parseout; lib$stop(xcopy_parseout, 2,@ output_namptr->nam$b_esl, output_namptr->nam$l_esa,' output_fabptr->fab$l_sts); }/*/ * If necessary, get user confirmation of copy. */ if (Confirm) { int ok = ok_to_copy(@ input_namptr->nam$b_rsl, input_namptr->nam$l_rsa,B output_namptr->nam$b_esl, output_namptr->nam$l_esa, First_block); if (ok == OK_NO) { return 0; } else if (ok == OK_ALL) { Confirm = 0; } else if (ok == OK_QUIT) { return 1; } } sys$open(input_fabptr, 0, 0);+ if ((input_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_openin; lib$stop(xcopy_openin, 2,> input_namptr->nam$b_esl, input_namptr->nam$l_esa,& input_fabptr->fab$l_sts); } blocks_per_io = Rms_iosize; blocksize = DISK_BLOCKSIZE;6 input_rabptr->rab$w_usz = blocksize * blocks_per_io;" sys$connect(input_rabptr, 0, 0);+ if ((input_rabptr->rab$l_sts & 1) != 1) { EXTERNAL xcopy_miscerr; lib$stop(xcopy_miscerr, 1,% input_rabptr->rab$l_stv,& input_rabptr->rab$l_sts); }/*5 * Actual last block of input file is now in the XAB. *// file_allocation = input_xabfhcptr->xab$l_ebk; if (!Last_block_seen) {! Last_block = file_allocation; }/*M * If we have not explicitly specified a trace interval, use 10% of the file. */$ if ((Trace) && (!Interval_seen)) {9 Interval = (file_allocation + NTRACES - 1) / NTRACES; }/*I * Interval (explicit or implicit) must be multiple of RMS transfer size. */( if ((Interval % blocks_per_io) != 0) {@ Interval = ((Interval / blocks_per_io) + 1) * blocks_per_io; }/*3 * Open a new output file, or append to an old one. */ if (New_file) {/ output_fabptr->fab$l_alq = file_allocation;7 output_fabptr->fab$b_bks = input_fabptr->fab$b_bks;7 output_fabptr->fab$w_deq = input_fabptr->fab$w_deq;O output_fabptr->fab$l_fop = input_fabptr->fab$l_fop | FAB$M_TEF | FAB$M_CBT;7 output_fabptr->fab$b_fsz = input_fabptr->fab$b_fsz;7 output_fabptr->fab$w_gbc = input_fabptr->fab$w_gbc;7 output_fabptr->fab$l_mrn = input_fabptr->fab$l_mrn;7 output_fabptr->fab$w_mrs = input_fabptr->fab$w_mrs;7 output_fabptr->fab$b_org = input_fabptr->fab$b_org;7 output_fabptr->fab$b_rat = input_fabptr->fab$b_rat;7 output_fabptr->fab$b_rfm = input_fabptr->fab$b_rfm;y= output_xabfhcptr->xab$w_lrl = input_xabfhcptr->xab$w_lrl;$ sys$create(output_fabptr, 0, 0);! output_rabptr->rab$l_bkt = 0;n }i else {" sys$open(output_fabptr, 0, 0);+ output_rabptr->rab$l_bkt = First_block;* }T, if ((output_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_openout;  lib$stop(xcopy_openout, 2,@ output_namptr->nam$b_esl, output_namptr->nam$l_esa,' output_fabptr->fab$l_sts);  }I# sys$connect(output_rabptr, 0, 0); , if ((output_rabptr->rab$l_sts & 1) != 1) { EXTERNAL xcopy_miscerr;" lib$stop(xcopy_miscerr, 1,& output_rabptr->rab$l_sts,' output_rabptr->rab$l_stv);c }n if (Trace) { if (New_file) { EXTERNAL xcopy_starting;# lib$signal(xcopy_starting, 4,OB input_namptr->nam$b_rsl, input_namptr->nam$l_rsa,E output_namptr->nam$b_rsl, output_namptr->nam$l_rsa);C } else { EXTERNAL xcopy_resuming;# lib$signal(xcopy_resuming, 5,aB input_namptr->nam$b_rsl, input_namptr->nam$l_rsa,D output_namptr->nam$b_rsl, output_namptr->nam$l_rsa, First_block); }. }/*K * Copy each block in turn. This might fail after each read or write; if itD * does, output a message saying how far we got before the failure. */ end_block = First_block - 1;" while (end_block < Last_block) { start_block = end_block + 1;3 if (sys$read(input_rabptr, 0, 0) == RMS$_EOF) {n- break; /* we shouldn't hit this. */t }c2 create_symbol(&block_symbol_des, start_block);- if ((input_rabptr->rab$l_sts & 1) != 1) {r EXTERNAL xcopy_readfail;! lib$stop(xcopy_readfail, 3,a start_block,r@ input_namptr->nam$b_rsl, input_namptr->nam$l_rsa,' input_rabptr->rab$l_sts,a( input_rabptr->rab$l_stv); } /*N * Actual end block depends on how many (partial) blocks we were able to read. */iJ end_block = start_block + ((input_rabptr->rab$w_rsz - 1) / blocksize);/*? * Next time, read the next bucket, wherever the first one was.r */u input_rabptr->rab$l_bkt = 0;/*" * Write as many bytes as we read. */f7 output_rabptr->rab$w_rsz = input_rabptr->rab$w_rsz;# sys$write(output_rabptr, 0, 0);i. if ((output_rabptr->rab$l_sts & 1) != 1) { EXTERNAL xcopy_writefail;e" lib$stop(xcopy_writefail, 3, start_block,(B output_namptr->nam$b_rsl, output_namptr->nam$l_rsa,( output_rabptr->rab$l_sts,) output_rabptr->rab$l_stv);g }:! output_rabptr->rab$l_bkt = 0; A if ((Trace) && (Interval) && ((end_block % Interval) == 0)) {c EXTERNAL xcopy_trace;S, lib$signal(xcopy_trace, 1, end_block); }I }L! sys$close(output_fabptr, 0, 0); , if ((output_fabptr->fab$l_sts & 1) != 1) { EXTERNAL xcopy_miscerr;% lib$stop(xcopy_miscerr, 1,& output_fabptr->fab$l_sts,' output_fabptr->fab$l_stv);  }b sys$close(input_fabptr, 0, 0);+ if ((input_fabptr->fab$l_sts & 1) != 1) {$ EXTERNAL xcopy_miscerr;v lib$stop(xcopy_miscerr, 1,% input_fabptr->fab$l_sts,l& input_fabptr->fab$l_stv); }l if (Log || Trace) { EXTERNAL xcopy_copied; lib$signal(xcopy_copied, 5,(@ input_namptr->nam$b_rsl, input_namptr->nam$l_rsa,B output_namptr->nam$b_rsl, output_namptr->nam$l_rsa, end_block); } return 0;%} /*H * Function to build a filename string from resultant string components.G * This is useful after the RS (and associated element fields) has beenIH * constructed by an RMS routine. We can then manipulate element fieldsI * (eg by setting them to zero length) and call this routine to build an; * appropriate default field. */)$build_filename (offset, target, nam) unsigned char *offset; char *target;  struct NAM *nam;{m *offset = 0;B copy_dn_field(offset, target, nam->nam$b_node, nam->nam$l_node);@ copy_dn_field(offset, target, nam->nam$b_dev, nam->nam$l_dev);@ copy_dn_field(offset, target, nam->nam$b_dir, nam->nam$l_dir);B copy_dn_field(offset, target, nam->nam$b_name, nam->nam$l_name);B copy_dn_field(offset, target, nam->nam$b_type, nam->nam$l_type);@ copy_dn_field(offset, target, nam->nam$b_ver, nam->nam$l_ver);}u+copy_dn_field (offset, target, size, field)a unsigned char *offset; char *target;  unsigned char size;w char *field;{ ( memcpy(&target[*offset], field, size); *offset += size;}; #ifdef DEBUGmy_trace (comment, size, data) char *comment; int size; char *data; {u if (data == 0) {6 printf("%s: pointer=0, size=%d\n", comment, size); }> else { char mybuf [255];n memcpy(mybuf, data, size); mybuf[size] = '\0';a) printf("%s: '%s'\n", comment, mybuf);a }n}_#endif/*- * Function to get user confirmation of copy.u */pHok_to_copy (input_len, input_name, output_len, output_name, first_block) int input_len; char *input_name;> int output_len;L char *output_name; int first_block;{; char message [255];_$ $DESCRIPTOR(message_des, message); char reply [255];n $DESCRIPTOR(reply_des, reply);: $DESCRIPTOR(text_create, "Copy !AD to !AD (Y,N,A,Q): "); $DESCRIPTOR(text_resume,E "Resume copy of !AD to !AD at block !UL (Y,N,A,Q): ");n char *prmlst [5];n char *control; int result;b short outlen; short replen;- prmlst[0] = input_len; prmlst[1] = input_name;F prmlst[2] = output_len;u prmlst[3] = output_name; prmlst[4] = first_block; if (New_file) {p control = &text_create;_ }a else { control = &text_resume; }p< result = sys$faol(control, &outlen, &message_des, prmlst); if ((result & 1) != 1) { lib$stop(result);= }u$ message_des.dsc$w_length = outlen; while (1) {p char *cp;a int error = 0;@ result = lib$get_command(&reply_des, &message_des, &replen); if ((result & 1) != 1) { lib$stop(result);B }  reply[replen] = '\0';M/ for (cp = reply; (*cp) && (!error); cp++) {n switch (*cp) { case 'A':( case 'a':  return OK_ALL; break; case 'Q':b case 'q':t return OK_QUIT;- break; case 'N':1 case 'n':  return OK_NO;, break; case 'Y': case 'y':i return OK_YES; break; case ' ': case '\t': break; default: error = 1; break; }; } }l}o/*A * Function to create DCL symbol with given numeric string value.  */_static!create_symbol (symbol_des, value)0& struct dsc$descriptor_s *symbol_des; int value;{ ' $DESCRIPTOR(value_des, "0000000000");x0 sprintf(value_des.dsc$a_pointer, "%d", value);; value_des.dsc$w_length = strlen(value_des.dsc$a_pointer);f8 lib$set_symbol(symbol_des, &value_des, &SYMBOL_TABLE);}e/*C * Function to call cli$get_value with valid descriptor parameters. */ staticmy_get_value (qualifier, value)  char *qualifier; char *value;{d! $DESCRIPTOR(qualifier_des, "");  $DESCRIPTOR(value_des, "");e int result;m short retlen;;* qualifier_des.dsc$a_pointer = qualifier;1 qualifier_des.dsc$w_length = strlen(qualifier); " value_des.dsc$a_pointer = value; value_des.dsc$w_length = 255; > result = cli$get_value(&qualifier_des, &value_des, &retlen); if (result & 1) { value[retlen] = '\0';t }m return result;}r/*B * Function to call cli$present with a valid descriptor parameter. */_staticmy_present (qualifier) char *qualifier;{=! $DESCRIPTOR(qualifier_des, "");- int result;d* qualifier_des.dsc$a_pointer = qualifier;1 qualifier_des.dsc$w_length = strlen(qualifier);m' result = cli$present(&qualifier_des);> return result;} /*H * Function to handle unexpected events (that indicate internal errors). */nstatic panic (s)y char *s;{n EXTERNAL xcopy_panic; ) lib$stop(xcopy_panic, 2, strlen(s), s);s}rext time round. */? memcpy(old_input_namptr, input_namptr, sizeof(struct NAM));/*> * Now rebuild the input filename using the previous defaults. */, build_filename(&input_fabptr->fab$b_dns,; input_fabptr->fab$l_dna, input_namptr); input_namp*[SRC.XCOPY]XCOPY.CLD;1+,VB./ 42-TB0123KPWO56@`s7 IE8Ƥj9@WvGHJDEFINE VERB XCOPY IMAGE "XCOPY" PARAMETER P1# PROMPT="Input file"2 VALUE (TYPE=$FILE, LIST, REQUIRED) PARAMETER P2$ PROMPT="Output file", VALUE (TYPE=$FILE, REQUIRED) QUALIFIER FIRST_BLOCK NONNEGATABLE. VALUE (TYPE=$NUMBER, REQUIRED) QUALIFIER LAST_BLOCK NONNEGATABLE. VALUE (TYPE=$NUMBER, REQUIRED) QUALIFIER WILD_FILE NONNEGATABLE. VALUE (TYPE=$NUMBER, REQUIRED) QUALIFIER LOG NEGATABLE QUALIFIER CONFIRM NEGATABLE QUALIFIER TRACE NEGATABLE$ VALUE (TYPE=$NUMBER) QUALIFIER RMS_IOSIZE NONNEGATABLE. VALUE (TYPE=$NUMBER, REQUIRED)*[SRC.XCOPY]XCOPY.EXE;1+,WB./ 4-TB0123 KPWO56@Γ7}8zt9GHJ0DX0205(gN"XCOPYV1.00gΓ05-05   ? ! VAXCRTL_001! LIBRTL_001! MTHRTL_001XCOPY_FAILED_BLOCKXCOPY_FAILED_FILEP1get_args: no parameter P1P2P2get_args: problem with P2get_args: no parameter P2FIRST_BLOCKFIRST_BLOCKget_args: problem with /FIRST_BLOCK%dLAST_BLOCKLAST_BLOCKget_args: problem with /LAST_BLOCK%dWILD_FILEWILD_FILEget_args: problem with /WILD_FILE%dLOGCONFIRMTRACETRACE%dRMS_IOSIZERMS_IOSIZEget_args: problem with /RMS_IOSIZE%dP1SYS$DISK:[]*.*Copy !AD to !AD (Y,N,A,Q): Resume copy of !AD to !AD at block !UL (Y,N,A,Q): 0000000000%d^;TW(UxVSTǴXޤ%͛͟͟͝͞P͛͛xPRR&ޤ(PߟdޤB͓͕͖͗͗yP͓͓ PRR=ߤE!PNޤH3Pߟd&ޤb   PߟdZԧޤ|͍͎͋͏͏P͋͋ZPRRKĈqP'Ĕ PߟdߧĸkRէRRԧ ЏĻ͇͇̓͆ͅP̓̓PRROϾP'Pߟd"ߧ {}~zP{{ PRRK!P' 6Pߟd߭-g0suvwwPsssPRRgԧ4kmnooPkk#PRRԧԧ<cefgg?PccPRR/gBPߧ H$K[]^__P[[RPRRKViP'a~Pߟdߧ$Ącէ$$ѧ$$eP"@,ЏV(S$05Jf`  Ԧ,cԣRP! R,ԢR(X$0J,hԨS`  ԣ΄ć. P11?Δ:ΐ0Ό#ΘV ZYQXͣRݥ,ޜݥ,ޔP4|~UޘˏPPݥݥ,4~ߟ*΄18P888~ݢ@ݦ@ޤ9P999~ݢDݦDޤ:P:::~ݢHݦHޤ;P;;;~ݢLݦLޤ?P?j?iP; ;Rh1OP΄ć# PE~ XCOPY.BCKWBTB[SRC.XCOPY]XCOPY.EXE;1  1EWS[R 3567R77P3 3S=SR +-./R//P+ +S2Px^-["WTЬRТ(YТ$X$VЬ SУ(ZУ$LdDR<Ч8$Ԥ@ԤfDS<(Ԧ@Ԧ448լ:=YЬ Sݣ05.|~S0ˏRRݣݪ ~ߟBէ5ݧݪ ~ݩ~0PPPԧ PPP|~ЬSSˏRRݣݩ ~ߟ2Ч$Ux URR |~TˏRRݤݤ ߟJoШSէ Sէէ SR R z P{UPQPP U RRUR էgЬ QSЬP>>ɏSɏ S??HHР8866ЮLR |~QԦ8P|~ݬ Ч8Ь SˏRRݣݪ ~ߟ: |~VˏRRݦ ݦߟJ^ էEէ ݪ~ݩ~ߟ3 !ݧݪ~ݩ~ߟ# XX1V hXU|~TPz11SUR RR 9 PSj ˏRRݤ ݤݩ~UߟRބ<"RRQRPЏR RP QP{RPQPUQXԤ8""|~VˏRRݦ ݦݪ~UߟZބԦ8է%է  zXP{ PQPPXߟ X1|~Ь SSˏRRݣ ݣߟJ~ |~ЬSSˏRRݣ ݣߟJL gէXݪ~ݩ~ߟ  P4^ЬUeЬ R8PЬVUTVQP,Т@P,SSPdP@a WgdPSPPd9PUTVQP(ТDP(SSPdP@agdPSPPd:PUTVQP$ТHP$SSPdP@agdPSPPd;PUTVQP ТLP SSPdP@agdPSPPd been deleted in the meantime), the effects of restarting are unpredictable. 2 DCL_symbolsE In the event of failure, the DCL symbol XCOPY_FAILED_BLOCK contains; (as a decimal string) the number of the failed block, andC XCOPY_FAILED_FILE contains the file number (relative to the inputG filespec) of the file containing the failed block. XCOPY can then beE restarted with the qualifiers /FIRST_BLOCK='XCOPY_FAILED_BLOCK' and! /WILD_FILE='XCOPY_FAILED_FILE'.; If the copy succeeds, XCOPY_FAILED_BLOCK is set to 0, and< XCOPY_FAILED_FILE to the number of files in the input fileH specification list, plus one. Restarting XCOPY with these values will not copy anything. 2 Examples- 1. $ XCOPY BIGFILE.DAT REMOTE::DUA0:[DIR]6 %XCOPY-F-WRITEFAIL, failed writing block 246 of' REMOTE::DUA0:[DIR]BIGFILE.DAT;18 $ XCOPY BIGFILE.DAT REMOTE::DUA0:[DIR] /FIRST=246@ The copy is restarted from the first untransmitted block.9 2. $ XCOPY SMALLFILE.DAT REMOTE::DUA0:[DIR] /TRACE=20G %XCOPY-S-COPYING, starting copy of DUA1:[EXAMPLE]SMALLFILE.DAT;1) to REMOTE::DUA0:[DIR]SMALLFILE.DAT3 %XCOPY-I-TRACE, successfully copied block 203 %XCOPY-I-TRACE, successfully copied block 40? %XCOPY-S-COPIED, DUA1:[EXAMPLE]SMALLFILE.DAT;1 copied to5 REMOTE::DUA0:[DIR]SMALLFILE.DAT;1 (47 blocks)0 This shows the successful copy of a file. 3. $ XCOPY_FAILED_BLOCK = 0 $ XCOPY_FAILED_FILE = 0 $ loop: $ on error then goto loopC $ XCOPY 'P1' 'P2' /TRACE /FIRST_BLOCK='XCOPY_FAILED_BLOCK' -> /WILD_FILE='XCOPY_FAILED_FILE'D This DCL procedure fragment shows, in elementary form, how to> write a procedure which will copy files and retry untilE successful. This example does not handle such things as retry@ counts, restart delays, etc, which would be required in a practical situation.*[SRC.XCOPY]XCOPY.OPT;1+,ZB./ 4(\-TB0123KPWO56 "2A7`8 wv9@WvGHJ(! Command line: LINK /NOTRACE XCOPY /OPT!xcopyxcopymsgsys$library:vaxcrtl/share*[SRC.XCOPY]XCOPY.PAS;1+,[B.6/ 4O64-TB0123KPWO556`<Gv7P8@Vw9@WvGHJD*{ XCOPY.PAS - copy files block by block. }7{ Copyright (C) Nick Brown 1989. All rights reserved. }#[ INHERIT ('SYS$LIBRARY:STARLET') ]PROGRAM xcopy (OUTPUT);CONST slen = 255; NTRACES = 10; TABLE = 1;, block_symbol_name = 'XCOPY_FAILED_BLOCK';+ file_symbol_name = 'XCOPY_FAILED_FILE';{ RMS parameters. } DISK_BLOCKSIZE = 512; RMS_IOSIZE_MIN = 1; RMS_IOSIZE_DEFAULT = 4; RMS_IOSIZE_MAX = 127; MAX_BUFFER = 65535;{ A default filespec. }( HERE = 'SYS$DISK:[]*.*';TYPE" string = VARYING [slen] OF CHAR;* chars = PACKED ARRAY [1..slen] OF CHAR; $UBYTE = [BYTE] 0..255; $UWORD = [WORD] 0..65535;#{ Replies to confirmation prompt. }- OK_type = (OK_NO, OK_YES, OK_ALL, OK_QUIT);E{ Global variables for CLI parameters, used throughout the program. }={ These are recognisable by their capitalised first letter. }VAR First_block : INTEGER; Last_block : INTEGER; Last_block_seen : BOOLEAN; New_file : BOOLEAN; Rms_iosize : INTEGER; Trace : BOOLEAN; Interval : INTEGER; Interval_seen : BOOLEAN; Log : BOOLEAN; Confirm : BOOLEAN;{- externals -}'PROCEDURE lib$movc3 ( %REF p1 : $UWORD;+ %IMMED p2 : UNSIGNED;- %IMMED p3 : UNSIGNED );EXTERN ;-PROCEDURE lib$stop ( condition : UNSIGNED;1 %IMMED p2 : INTEGER := 0;2 %IMMED p3 : UNSIGNED := 0;2 %IMMED p4 : UNSIGNED := 0;2 %IMMED p5 : UNSIGNED := 0;2 %IMMED p6 : UNSIGNED := 0;4 %IMMED p7 : UNSIGNED := 0 );EXTERN ;-PROCEDURE lib$signal ( condition : UNSIGNED;1 %IMMED p2 : INTEGER := 0;2 %IMMED p3 : UNSIGNED := 0;2 %IMMED p4 : UNSIGNED := 0;2 %IMMED p5 : UNSIGNED := 0;2 %IMMED p6 : UNSIGNED := 0;4 %IMMED p7 : UNSIGNED := 0 );EXTERN ;.PROCEDURE lib$set_symbol ( %DESCR s1 : string;. %DESCR s2 : string;6 %REF tbl : INTEGER := 1 );EXTERN ;-FUNCTION lib$get_command ( %DESCR s1 : chars;. %DESCR s2 : string;: %REF rl : $UWORD ) : INTEGER;EXTERN ;,FUNCTION cli$get_value ( %DESCR s1 : string;, %DESCR s2 : string;: %REF rl : UNSIGNED ) : INTEGER;EXTERN ;6FUNCTION cli$present ( %DESCR s1 : string ) : INTEGER;EXTERN ; {- panic -}PROCEDURE panic ( s : string );VAR' xcopy_panic : [EXTERNAL] UNSIGNED;BEGIN3 lib$stop(xcopy_panic, 2, LENGTH(s), IADDRESS(s));END;{- create_symbol -}*PROCEDURE create_symbol ( symbol : string;- value : INTEGER );VAR svalue : string;BEGIN WRITEV(svalue, value : 0);( lib$set_symbol(symbol, svalue, TABLE);END; {- memcpy -}%PROCEDURE memcpy ( target : UNSIGNED;% source : UNSIGNED;% count : $UBYTE );VAR wcount : $UWORD;BEGIN wcount := count;$ lib$movc3(wcount, source, target);END;{- ok_to_copy -}*FUNCTION ok_to_copy ( input_len : INTEGER;, input_name : UNSIGNED;+ output_len : INTEGER;- output_name : UNSIGNED;8 first_block : INTEGER ) : OK_type;VAR message : string; reply : string; control : string;% prmlst : ARRAY [0..4] OF UNSIGNED; result : UNSIGNED; outlen : $UWORD; replen : $UWORD; i : INTEGER; error : BOOLEAN;LABEL ok_to_copy_return;BEGIN prmlst[0] := input_len; prmlst[1] := input_name; prmlst[2] := output_len; prmlst[3] := output_name; prmlst[4] := first_block; IF (New_file) THEN BEGIN- control := 'Copy !AD to !AD (Y,N,A,Q): '; END ELSE BEGIND control := 'Resume copy of !AD to !AD at block !UL (Y,N,A,Q): '; END;A result := $faol(control, message.LENGTH, message.BODY, prmlst); IF (NOT ODD (result)) THEN BEGIN lib$stop(result); END; WHILE (TRUE) DO BEGIN error := FALSE;B result := lib$get_command(reply.BODY, message, LENGTH(reply)); IF (NOT ODD (result)) THEN BEGIN lib$stop(result); END; i := 1;3 WHILE ((i <= LENGTH(reply)) AND (NOT error)) DO BEGIN4 IF ((reply[i] = 'A') OR (reply[i] = 'a')) THEN BEGIN ok_to_copy := OK_ALL; GOTO ok_to_copy_return; END9 ELSE IF ((reply[i] = 'Q') OR (reply[i] = 'q')) THEN BEGIN ok_to_copy := OK_QUIT; GOTO ok_to_copy_return; END9 ELSE IF ((reply[i] = 'N') OR (reply[i] = 'n')) THEN BEGIN ok_to_copy := OK_NO; GOTO ok_to_copy_return; END9 ELSE IF ((reply[i] = 'Y') OR (reply[i] = 'y')) THEN BEGIN ok_to_copy := OK_YES; GOTO ok_to_copy_return; END< ELSE IF ((reply[i] = ' ') OR (ORD(reply[i]) = 9)) THEN BEGIN ; END ELSE BEGIN error := TRUE; END; i := i + 1; END; END; ok_to_copy_return:END;{- copy_dn_field -}.PROCEDURE copy_dn_field ( VAR offset : $UBYTE;0 target : UNSIGNED;. size : $UBYTE;2 field : UNSIGNED );BEGIN' memcpy(target + offset, field, size); offset := offset + size;END;{- build_filename -}/PROCEDURE build_filename ( VAR offset : $UBYTE;1 target : UNSIGNED;3 VAR nam : NAM$TYPE );VAR hack : string;BEGIN offset := 0;@ copy_dn_field(offset, target, nam.nam$b_node, nam.nam$l_node);> copy_dn_field(offset, target, nam.nam$b_dev, nam.nam$l_dev);> copy_dn_field(offset, target, nam.nam$b_dir, nam.nam$l_dir);@ copy_dn_field(offset, target, nam.nam$b_name, nam.nam$l_name);@ copy_dn_field(offset, target, nam.nam$b_type, nam.nam$l_type);> copy_dn_field(offset, target, nam.nam$b_ver, nam.nam$l_ver);END;{- copy_one_file -}7FUNCTION copy_one_file ( fileno : INTEGER;8 VAR input_fab : FAB$TYPE;8 VAR output_fab : FAB$TYPE;C output_dir_wild : BOOLEAN ) : BOOLEAN;TYPE0 block = PACKED ARRAY [1..MAX_BUFFER] OF CHAR; NAMptr = ^NAM$TYPE; XABptr = ^XAB$TYPE;VAR start_block : INTEGER; end_block : INTEGER; input_nam : NAMptr; input_xabfhc : XABptr; input_rab : RAB$TYPE; output_nam : NAMptr; output_rab : RAB$TYPE; output_xabfhc : XABptr; file_buffer : block; ok : OK_type; blocks_per_io : INTEGER; blocksize : INTEGER; file_allocation : INTEGER;* xcopy_trace : [EXTERNAL] UNSIGNED;* xcopy_copied : [EXTERNAL] UNSIGNED;* xcopy_miscerr : [EXTERNAL] UNSIGNED;* xcopy_openin : [EXTERNAL] UNSIGNED;* xcopy_openout : [EXTERNAL] UNSIGNED;* xcopy_parseout : [EXTERNAL] UNSIGNED;* xcopy_readfail : [EXTERNAL] UNSIGNED;* xcopy_writefail : [EXTERNAL] UNSIGNED;* xcopy_starting : [EXTERNAL] UNSIGNED;* xcopy_resuming : [EXTERNAL] UNSIGNED;LABEL copy_one_file_return, break_read_write_loop;BEGIN+ input_nam := input_fab.fab$l_nam::NAMptr;. input_xabfhc := input_fab.fab$l_xab::XABptr;- output_nam := output_fab.fab$l_nam::NAMptr;0 output_xabfhc := output_fab.fab$l_xab::XABptr;{ Set up the RABs. }# input_rab.rab$b_bid := RAB$C_BID;# input_rab.rab$b_bln := RAB$C_BLN;- input_rab.rab$l_fab := IADDRESS(input_fab);% input_rab.rab$l_bkt := first_block;/ input_rab.rab$l_ubf := IADDRESS(file_buffer); input_rab.rab$l_xab := 0; input_rab.rab$l_rop := 0;$ output_rab.rab$b_bid := RAB$C_BID;$ output_rab.rab$b_bln := RAB$C_BLN;/ output_rab.rab$l_fab := IADDRESS(output_fab);0 output_rab.rab$l_rbf := IADDRESS(file_buffer); output_rab.rab$l_xab := 0; output_rab.rab$l_rop := 0;E{ If the input or output file name contains a node name, remove the }N{ node name, device, directory, and version number from the resultant input }/{ file name before applying it as a default. }9{ Otherwise, use the extended input file specification. }J{ Exception: if we had a wildcard in our DCL output file directory spec, }*{ use the input directory as a default. }7 IF ( (UAND(input_nam^.nam$l_fnb, NAM$M_NODE) <> 0)8 OR (UAND(output_nam^.nam$l_fnb, NAM$M_NODE) <> 0) ) THEN BEGIN input_nam^.nam$b_node := 0; input_nam^.nam$b_dev := 0;! IF (NOT output_dir_wild) THEN BEGIN input_nam^.nam$b_dir := 0; END; input_nam^.nam$b_ver := 0; END;& build_filename(output_fab.fab$b_dns,3 output_fab.fab$l_dna, input_nam^);({ Find the definitive target filename. } output_nam^.nam$b_nop := 0; $parse(output_fab, , );* IF (NOT ODD (output_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_parseout, 2,: output_nam^.nam$b_esl, output_nam^.nam$l_esa,# output_fab.fab$l_sts); END;0{ If necessary, get user confirmation of copy. } IF (Confirm) THEN BEGIN ok := ok_to_copy(6 input_nam^.nam$b_rsl, input_nam^.nam$l_rsa,8 output_nam^.nam$b_esl, output_nam^.nam$l_esa, First_block); IF (ok = OK_NO) THEN BEGIN copy_one_file := TRUE; GOTO copy_one_file_return; END ELSE IF (ok = OK_ALL) THEN BEGIN Confirm := FALSE; END ELSE IF (ok = OK_QUIT) THEN BEGIN copy_one_file := FALSE; GOTO copy_one_file_return; END; END; $open(input_fab, , );) IF (NOT ODD (input_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_openin, 2,8 input_nam^.nam$b_esl, input_nam^.nam$l_esa," input_fab.fab$l_sts); END; blocks_per_io := Rms_iosize; blocksize := DISK_BLOCKSIZE;3 input_rab.rab$w_usz := blocksize * blocks_per_io; $connect(input_rab, , );) IF (NOT ODD (input_rab.rab$l_sts)) THEN BEGIN lib$stop(xcopy_miscerr, 1,! input_rab.rab$l_sts," input_rab.rab$l_stv); END;6{ Actual last block of input file is now in the XAB. }6 file_allocation := input_xabfhc^.xab$l_ebk::INTEGER; IF (NOT Last_block_seen) THEN BEGIN" Last_block := file_allocation; END;N{ If we have not explicitly specified a trace interval, use 10% of the file. }+ IF ((trace) AND (NOT Interval_seen)) THEN BEGIN< Interval := (file_allocation + NTRACES - 1) DIV NTRACES; END;J{ Interval (explicit or implicit) must be multiple of RMS transfer size. }, IF ((Interval MOD blocks_per_io) > 0) THEN BEGINC Interval := ((Interval DIV blocks_per_io) + 1) * blocks_per_io; END; $parse(output_fab, , );* IF (NOT ODD (output_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_parseout, 2,: output_nam^.nam$b_esl, output_nam^.nam$l_esa,# output_fab.fab$l_sts); END;4{ Open a new output file, or append to an old one. } IF (New_file) THEN BEGIN, output_fab.fab$l_alq := file_allocation;0 output_fab.fab$b_bks := input_fab.fab$b_bks;0 output_fab.fab$w_deq := input_fab.fab$w_deq;0 output_fab.fab$l_fop := input_fab.fab$l_fop;A output_fab.fab$l_fop := UOR(output_fab.fab$l_fop, FAB$M_TEF);A output_fab.fab$l_fop := UOR(output_fab.fab$l_fop, FAB$M_CBT);0 output_fab.fab$b_fsz := input_fab.fab$b_fsz;0 output_fab.fab$w_gbc := input_fab.fab$w_gbc;0 output_fab.fab$l_mrn := input_fab.fab$l_mrn;0 output_fab.fab$w_mrs := input_fab.fab$w_mrs;0 output_fab.fab$b_org := input_fab.fab$b_org;0 output_fab.fab$b_rat := input_fab.fab$b_rat;0 output_fab.fab$b_rfm := input_fab.fab$b_rfm;8 output_xabfhc^.xab$w_lrl := input_xabfhc^.xab$w_lrl; $create(output_fab, , ); output_rab.rab$l_bkt := 0; END ELSE BEGIN $open(output_fab, , );( output_rab.rab$l_bkt := First_block; END;* IF (NOT ODD (output_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_openout, 2,: output_nam^.nam$b_esl, output_nam^.nam$l_esa,# output_fab.fab$l_sts); END; $connect(output_rab, , );* IF (NOT ODD (output_rab.rab$l_sts)) THEN BEGIN lib$stop(xcopy_miscerr, 1," output_rab.rab$l_sts,# output_rab.rab$l_stv); END; IF (Trace) THEN BEGIN IF (New_file) THEN BEGIN# lib$signal(xcopy_starting, 4,< input_nam^.nam$b_rsl, input_nam^.nam$l_rsa,? output_nam^.nam$b_rsl, output_nam^.nam$l_rsa); END ELSE BEGIN# lib$signal(xcopy_resuming, 5,< input_nam^.nam$b_rsl, input_nam^.nam$l_rsa,> output_nam^.nam$b_rsl, output_nam^.nam$l_rsa, First_block); END; END;L{ Copy each block in turn. This might fail after each read or write; if it }E{ does, output a message saying how far we got before the failure. } end_block := First_block - 1;# WHILE (end_block < Last_block) DO BEGIN! start_block := end_block + 1;- IF ($read(input_rab, , ) = RMS$_EOF) THEN BEGIN { we shouldn't hit this. }) {BREAK} GOTO break_read_write_loop; END;2 create_symbol(block_symbol_name, start_block);+ IF (NOT ODD (input_rab.rab$l_sts)) THEN BEGIN! lib$stop(xcopy_readfail, 3, start_block,: input_nam^.nam$b_rsl, input_nam^.nam$l_rsa,# input_rab.rab$l_sts,$ input_rab.rab$l_stv); END;O{ Actual end block depends on how many (partial) blocks we were able to read. }I end_block := start_block + ((input_rab.rab$w_rsz - 1) DIV blocksize);O{ Next time, read the NEXT bucket, regardless of what we read the first time. } input_rab.rab$l_bkt := 0;#{ Write as many bytes as we read. }0 output_rab.rab$w_rsz := input_rab.rab$w_rsz; $write(output_rab, , );, IF (NOT ODD (output_rab.rab$l_sts)) THEN BEGIN" lib$stop(xcopy_writefail, 3, start_block,< output_nam^.nam$b_rsl, output_nam^.nam$l_rsa,$ output_rab.rab$l_sts,% output_rab.rab$l_stv); END; output_rab.rab$l_bkt := 0;K IF ((Trace) AND (Interval > 0) AND ((end_block MOD Interval) = 0)) THEN BEGIN, lib$signal(xcopy_trace, 1, end_block); END; END; {BREAK} break_read_write_loop: $close(output_fab, , );* IF (NOT ODD (output_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_miscerr, 1," output_fab.fab$l_sts,# output_fab.fab$l_stv); END; $close(input_fab, , );) IF (NOT ODD (input_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_miscerr, 1,! input_fab.fab$l_sts," input_fab.fab$l_stv); END; IF ((log) OR (trace)) THEN BEGIN lib$signal(xcopy_copied, 5,: input_nam^.nam$b_rsl, input_nam^.nam$l_rsa,< output_nam^.nam$b_rsl, output_nam^.nam$l_rsa, end_block); END; copy_one_file := TRUE; copy_one_file_return:END; {- main -}PROCEDURE main;CONST CLI$_ABSENT = %X'000381F0'; CLI$_PRESENT = %X'0003FD19';VAR input_fab : FAB$TYPE; input_nam : NAM$TYPE; old_input_nam : NAM$TYPE; input_xabfhc : XAB$TYPE; output_fab : FAB$TYPE; output_nam : NAM$TYPE; output_xabfhc : XAB$TYPE; input_expname : chars; input_resname : chars; input_defname : chars; input_filename : chars; output_expname : chars; output_resname : chars; output_defname : chars; output_filename : chars; infile : string; outfile : string;y value : string;o retlen : UNSIGNED;l start_fileno : INTEGER; actual_fileno : INTEGER; tblock : INTEGER; first_filespec : BOOLEAN; len : INTEGER; output_dir_wild : BOOLEAN; defspec : string;'( xcopy_openin : [EXTERNAL] UNSIGNED;( xcopy_parsein : [EXTERNAL] UNSIGNED;( xcopy_parseout : [EXTERNAL] UNSIGNED;LABELN break_search_loop, break_filespec_loop;BEGINX${ Get the command line parameters. }+ IF (cli$present('P1') = CLI$_ABSENT) THEN  BEGIN'' panic('get_args: no parameter P1');I END;, IF (cli$present('P1') = CLI$_PRESENT) THEN BEGIN @ IF (cli$get_value('P2', outfile, retlen) = CLI$_ABSENT) THEN BEGINm) panic('get_args: problem with P2');S END; END) ELSE BEGINr' panic('get_args: no parameter P2');t END; First_block := 0;e5 IF (cli$present('FIRST_BLOCK') = CLI$_PRESENT) THEN BEGINlG IF (cli$get_value('FIRST_BLO3<2~ XCOPY.BCK[BTB[SRC.XCOPY]XCOPY.PAS;1O6$#CK', value, retlen) <> SS$_NORMAL) THENL BEGIN_3 panic('get_args: problem with /FIRST_BLOCK'); END; READV(value, First_block); END; New_file := (First_block = 0); IF (New_file) THEN BEGIN; First_block := 1;O END; Last_block := %X'7FFFFFFF';$ Last_block_seen := FALSE; 4 IF (cli$present('LAST_BLOCK') = CLI$_PRESENT) THEN BEGIN F IF (cli$get_value('LAST_BLOCK', value, retlen) <> SS$_NORMAL) THEN BEGIND2 panic('get_args: problem with /LAST_BLOCK'); END; READV(value, Last_block);N Last_block_seen := TRUE; END; Start_fileno := 1;3 IF (cli$present('WILD_FILE') = CLI$_PRESENT) THEN; BEGIN E IF (cli$get_value('WILD_FILE', value, retlen) <> SS$_NORMAL) THENM BEGINI1 panic('get_args: problem with /WILD_FILE');o END; READV(value, Start_fileno);  END; Log := FALSE;- IF (cli$present('LOG') = CLI$_PRESENT) THEN: BEGIN  Log := TRUE; END; Confirm := FALSE; 1 IF (cli$present('CONFIRM') = CLI$_PRESENT) THEN  BEGIN  Confirm := TRUE; END; Trace := FALSE;  Interval_seen := FALSE;I/ IF (cli$present('TRACE') = CLI$_PRESENT) THENl BEGIN  Trace := TRUE;@ IF (cli$get_value('TRACE', value, retlen) = SS$_NORMAL) THEN BEGIN  READV(value, Interval); Interval_seen := TRUE; END; END;# Rms_iosize := RMS_IOSIZE_DEFAULT;s4 IF (cli$present('RMS_IOSIZE') = CLI$_PRESENT) THEN BEGINEF IF (cli$get_value('RMS_IOSIZE', value, retlen) <> SS$_NORMAL) THEN BEGIN 1 panic('get_args: problem with RMS_IOSIZE');E END; READV(value, Rms_iosize); END;' IF (Rms_iosize < RMS_IOSIZE_MIN) THENE BEGINE! Rms_iosize := RMS_IOSIZE_MIN;a END;' IF (Rms_iosize > RMS_IOSIZE_MAX) THENX BEGINN! Rms_iosize := RMS_IOSIZE_MAX;y END;'{ Set up the FABs and related blocks. }e# input_fab.fab$b_bid := FAB$C_BID;o# input_fab.fab$b_bln := FAB$C_BLN; = input_fab.fab$b_fac := (UOR(FAB$M_BIO, FAB$M_GET))::$UBYTE;E# input_fab.fab$b_shr := FAB$M_UPI; 2 input_fab.fab$l_fna := IADDRESS(input_filename);# input_fab.fab$l_fop := FAB$M_NAM; - input_fab.fab$l_nam := IADDRESS(input_nam);N0 input_fab.fab$l_xab := IADDRESS(input_xabfhc); input_fab.fab$w_ifi := 0;I1 input_fab.fab$l_dna := IADDRESS(input_defname);  input_fab.fab$b_dns := 0;p input_fab.fab$v_lnm_mode := 0;# input_nam.nam$b_bid := NAM$C_BID; # input_nam.nam$b_bln := NAM$C_BLN; 1 input_nam.nam$l_esa := IADDRESS(input_expname);  input_nam.nam$b_ess := slen;1 input_nam.nam$l_rsa := IADDRESS(input_resname);; input_nam.nam$b_rss := slen; input_nam.nam$l_rlf := 0; ) input_xabfhc.xab$b_bln := XAB$C_FHCLEN;N& input_xabfhc.xab$b_cod := XAB$C_FHC; input_xabfhc.xab$l_nxt := 0;$ output_fab.fab$b_bid := FAB$C_BID;$ output_fab.fab$b_bln := FAB$C_BLN;> output_fab.fab$b_fac := (UOR(FAB$M_BIO, FAB$M_PUT))::$UBYTE;$ output_fab.fab$b_shr := FAB$M_NIL; output_fab.fab$w_ifi := 0;4 output_fab.fab$l_fna := IADDRESS(output_filename);2 output_fab.fab$l_xab := IADDRESS(output_xabfhc);$ output_fab.fab$l_fop := FAB$M_NAM;/ output_fab.fab$l_nam := IADDRESS(output_nam);)3 output_fab.fab$l_dna := IADDRESS(output_defname);N! output_fab.fab$v_lnm_mode := 0;($ output_nam.nam$b_bid := NAM$C_BID;$ output_nam.nam$b_bln := NAM$C_BLN;3 output_nam.nam$l_esa := IADDRESS(output_expname);t output_nam.nam$b_ess := slen;e3 output_nam.nam$l_rsa := IADDRESS(output_resname);N output_nam.nam$b_rss := slen;l output_nam.nam$l_rlf := 0;* output_xabfhc.xab$b_bln := XAB$C_FHCLEN;' output_xabfhc.xab$b_cod := XAB$C_FHC;  output_xabfhc.xab$l_nxt := 0; defspec := HERE; first_filespec := TRUE; ? WHILE (cli$get_value('P1', infile, retlen) <> CLI$_ABSENT) DO= BEGIN(G memcpy(input_fab.fab$l_fna, IADDRESS(infile.BODY), LENGTH(infile)); * input_fab.fab$b_fns := LENGTH(infile);/{ Split out the fields of the input filename. }T( input_nam.nam$b_nop := NAM$M_SYNCHK; $parse(input_fab, , );+ IF (NOT ODD (input_fab.fab$l_sts)) THEN] BEGIN( lib$stop(xcopy_parsein, 2,8 input_fab.fab$b_fns, input_fab.fab$l_fna,$ input_fab.fab$l_sts); END;M{ If this is the second or subsequent filespec, apply defaults from before. } IF (NOT first_filespec) THEN BEGIN ( IF (input_nam.nam$b_node = 0) THEN BEGINt9 input_nam.nam$b_node := old_input_nam.nam$b_node;o> memcpy(input_nam.nam$l_node, old_input_nam.nam$l_node,% input_nam.nam$b_node); END;' IF (input_nam.nam$b_dev = 0) THEN BEGINU7 input_nam.nam$b_dev := old_input_nam.nam$b_dev;)< memcpy(input_nam.nam$l_dev, old_input_nam.nam$l_dev,$ input_nam.nam$b_dev); END;' IF (input_nam.nam$b_dir = 0) THENN BEGIN 7 input_nam.nam$b_dir := old_input_nam.nam$b_dir; < memcpy(input_nam.nam$l_dir, old_input_nam.nam$l_dir,$ input_nam.nam$b_dir); END;( IF (input_nam.nam$b_name = 0) THEN BEGINv9 input_nam.nam$b_name := old_input_nam.nam$b_name;l> memcpy(input_nam.nam$l_name, old_input_nam.nam$l_name,% input_nam.nam$b_name);t END;( IF (input_nam.nam$b_type = 0) THEN BEGINa9 input_nam.nam$b_type := old_input_nam.nam$b_type;> memcpy(input_nam.nam$l_type, old_input_nam.nam$l_type,% input_nam.nam$b_type); END; END;.{ Remember the defaults for next time round. } old_input_nam := input_nam;_9{ Now rebuild the filename using the previous defaults. }R' build_filename(input_fab.fab$b_dns,A3 input_fab.fab$l_dna, input_nam);c input_nam.nam$b_nop := 0;  $parse(input_fab, , );+ IF (NOT ODD (input_fab.fab$l_sts)) THEN BEGIN lib$stop(xcopy_parsein, 2,8 input_fab.fab$b_fns, input_fab.fab$l_fna,$ input_fab.fab$l_sts); END;H{ Split out the fields of the output filename, using a simple default. }J memcpy(output_fab.fab$l_fna, IADDRESS(outfile.BODY), LENGTH(outfile));, output_fab.fab$b_fns := LENGTH(outfile);J memcpy(output_fab.fab$l_dna, IADDRESS(defspec.BODY), LENGTH(defspec));, output_fab.fab$b_dns := LENGTH(defspec);) output_nam.nam$b_nop := NAM$M_SYNCHK;R $parse(output_fab, , );l, IF (NOT ODD (output_fab.fab$l_sts)) THEN BEGINAM lib$stop(xcopy_parseout, 2, output_fab.fab$b_fns, output_fab.fab$l_fna, % output_fab.fab$l_sts);o END;L{ Remove wildcards from output filespec (we use input filespec as default. } output_dir_wild := FALSE;_= IF (UAND(output_nam.nam$l_fnb, NAM$M_WILD_DIR) <> 0) THENA BEGINu output_nam.nam$b_dir := 0; output_dir_wild := TRUE; END;> IF (UAND(output_nam.nam$l_fnb, NAM$M_WILD_NAME) <> 0) THEN BEGINu! output_nam.nam$b_name := 0;a END;> IF (UAND(output_nam.nam$l_fnb, NAM$M_WILD_TYPE) <> 0) THEN BEGINf! output_nam.nam$b_type := 0; END;= IF (UAND(output_nam.nam$l_fnb, NAM$M_WILD_VER) <> 0) THENu BEGINb output_nam.nam$b_ver := 0; END;( build_filename(output_fab.fab$b_fns,5 output_fab.fab$l_fna, output_nam);b actual_fileno := 0;r WHILE (TRUE) DOp BEGINt $search(input_fab, , );,. IF (input_fab.fab$l_sts = RMS$_NMF) THEN BEGINn' {BREAK} GOTO break_search_loop; END 2 ELSE IF (NOT ODD (input_fab.fab$l_sts)) THEN BEGIN ! lib$stop(xcopy_openin, 2,:: input_nam.nam$b_esl, input_nam.nam$l_esa,& input_fab.fab$l_sts); END;) actual_fileno := actual_fileno + 1;O- IF (actual_fileno >= start_fileno) THENn BEGIN)7 create_symbol(file_symbol_name, actual_fileno);  IF (New_file) THEN BEGIN  tblock := 0; ENDE ELSE BEGINd tblock := First_block; END;1 create_symbol(block_symbol_name, tblock);,C IF (NOT copy_one_file(actual_fileno, input_fab, output_fab,f4 output_dir_wild)) THEN BEGINr+ {BREAK} GOTO break_filespec_loop;a END;; create_symbol(file_symbol_name, actual_fileno + 1);o, create_symbol(block_symbol_name, 0); First_block := 1;$ New_file := TRUE;c END; END; {BREAK} break_search_loop:'{ End of processing for one filespec. } first_filespec := FALSE; END; {BREAK} break_filespec_loop:,{ Finished processing all input filespecs. }5 create_symbol(file_symbol_name, actual_fileno + 1); & create_symbol(block_symbol_name, 0);END;{- main program -}BEGINL main; END.) THEN BEGIN Confirm := FALSE; END ELSE IF (ok = OK_QUIT) THEN BEGIN copy_one_file := FALSE; GOTO copy_one_file_return; END; END; $open(input_fab, , );) IF (NOT ODD (input_fab.fab$l_sts))*[SRC.XCOPY]XCOPYMSG.MSG;1+,\B./ 4K0-TB0123KPWO56  s78 /_q9@WvGHJ.facility xcopy, 1.severity success8COPIED /FAO=3.severity informational5TRACE /FAO=13STARTING /FAO=2KRESUMING /FAO=3.severity error8PARSEIN /FAO=12OPENIN /FAO=13OPENOUT /FAO=13PARSEOUT /FAO=17MISCERR /FAO=17READFAIL /FAO=27WRITEFAIL /FAO=2.severity fatal-PANIC /FAO=1.endS