program sendnet
c
c	Version 2.0
c
c 	copyright J.Dutertre 1983, 1984, 1985
c
c	non commercial use of this utility is allowed
c
c	la syntaxe de la commande est:
c
c	SENDNET /QUALIF= ..     fichier_depart  fichier_cible
c
c	/CODE=ii 
c		 2 /COPY
c		 5 /QUEUE=
c		 7 /INSTALL
c		 9 /DCL
c
c		99 /CLEAN
c	/NOEUD=(R1,R2,..ALL,WORLD) 
c	
c	/UIC_CIBLE=[g,m]
c	/COMMANDE="DELETE IFP:ESSAI.DAT.*"
c	/PROTECTION=(G:REW,W)
c	/QUALIF="/DEL/CONFIR"
c	/NOTIFY to get a mail when done
c	/NONOTIFY
c	/OUT=nomdefichier for HASP routing
c	/WIDE to reach all nodes including these within a cluster
c	/CLUSTER to reach the nodes of the current cluster
c	/CLUSTER="C1,C2" to reach clusters C1 and C2 this is
c			not available yet
c	/NOWIDE to reach one node per cluster (default)
c	/LOCAL  
c	/NOLOCAL (default is local if ALL is used)
c	CODE 	defaults to 2
c	NOEUD 	defaults to ALL
c
c	/NOHEAD /NOFEED /NOFORM /DELETE sont retransmis en temps que QUALIFIER
c	
c	other qualifiers are used or not depending on the value of CODE
c
c	CODE
c	 1	copy fichier_depart into fichier_cible
c	 2	as 1 followed by purge
c	 3 	as 2 followed by @
c	 5 	print fichier_depart on a remote printer
c	 7 	as 2 but runs INSTALL with fichier_cible/replace
c	 9 	runs a DCL command remotely
c	 10	route with HSP command via a remote node
c	 11	return from above
c	 12	route with HSP via a VAX on same cluster
c  	 99	cleaning up of problems
c 
c HISTORY
c
c DATE		AUTHOR		COMMENT
c 01.10.84	J.Dutertre	first version
c 29.10.84	J.Dutertre	suppress correction of UIC before call
c				to PARSE
c 18.03.85	J.Dutertre	Add cluster handling for VMS4 using
c				parameter WIDE and file IFP:SENDNET.NET
c				with /CLUSTER_NAME option
c 12.04.85      J.Dutertre      Add code 12 for HSP routing on a cluster
c----------------------------------------------------------------------
	character*2	CODE
	character*80	LISTE_NOEUD
	character*12	UIC_DEPART
	character*12	USERNAME
	character*23 	JOUR
	character*12	UIC_CIBLE
	character*256	COMMANDE
	character*20	PROTECTION
	character*80	QUALIFIER
	character*6	NOTIFY
	character*60 	FICHIER_DEPART
	character*60	FICHIER_DEPART_COMPLET
	character*60 	FICHIER_CIBLE
	character*60	FICHIER_CIBLE_COMPLET
	character*60	FICHIER_OUT
	character*40	QUEUE
	character*10	NB_COPIES
	character*20	NOEUD_CIBLE(1000)
	character*20	NOEUD_CIBLE2(1000)
	integer		NB_NOEUD_CIBLE
	integer		NB_NOEUD_CIBLE2
	character*20	LOCAL_NODE
	integer		LOCAL
	character*6	Cluster_Wide
	integer		Cluster		! 0 if no cluster request 1 else
	character*20	MASTER_NODE(16)	! this is initialized in he program.
	integer 	NB_MASTER_NODE
c					! CODEs.
	character*9	FILENUMBER
	character*60	NOM_DEMANDE
	character*60	DEMANDE_NOD
	character*60	DEMANDE_DAT
	integer		KAS_COPY	! indicateur de copie du fichier depart
	character*10	OK
c----------------------------------------------------------------------
	character*256   COMMANDE_DCL
	integer		L_COMMANDE
	character*80	QUALIF(80), VALEUR(80), PARAM(80)
	integer		NUM_PAR(20)
	integer		NBQUALIF
	integer		NBPARAM
	integer		PARSE
	integer 	K_PARSE
c----------------------------------------------------------------------
c
c	.... set master nodes
c
	MASTER_NODE(1)= 'R2'
	MASTER_NODE(2)= 'R3'
	MASTER_NODE(3)= 'R4'
	MASTER_NODE(4)= 'R5'
	NB_MASTER_NODE= 4
	call GET_NETWORK
c
	open (unit=6, name='SYS$OUTPUT',status='UNKNOWN')
	open (unit=5, name='SYS$INPUT',status='UNKNOWN')
	call lib$get_foreign ( COMMANDE_DCL, , L_COMMANDE )
	PARAM(1)= '    '
	PARAM(2)= '    '
	call uppercase ( COMMANDE_DCL, COMMANDE_DCL)
	do I= 1, 20
		PARAM(I) = ' '
	enddo
	K_PARSE= parse ( COMMANDE_DCL, QUALIF, NBQUALIF, NUM_PAR, VALEUR,
	1		PARAM, NBPARAM)
	if ( .not. K_PARSE) call exit ( K_PARSE )
c	.... valeurs par defaut
	CODE		= '2'
	COMMANDE	= ' '
	LISTE_NOEUD	= 'ALL'
	LOCAL		= 1
	CLUSTER		= 0
	Cluster_Wide	= 'NOWIDE'
	FICHIER_OUT	= ' '
	NOTIFY		= ' '
	NB_COPIES	= ' '
	PROTECTION 	= '(G:REW,W)'
	QUALIFIER	= ' '
	QUEUE		= ' '
	call P_UIC ( UIC_DEPART )
	UIC_CIBLE= UIC_DEPART
	do I = 1, NBQUALIF
		if (QUALIF(I)(1:3) .eq. 'CLE') CODE = '99'
		if (QUALIF(I)(1:3) .eq. 'CLU'  ) CLUSTER= 1
		if (QUALIF(I)(1:3) .eq. 'COD'  ) CODE = VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'COM'  ) COMMANDE = VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'COP'  ) then
			CODE = '2'
			if ( left0(VALEUR(I)) .ne. 0 ) call erreur
	1		( 'erreur sur le qualifier COP..')
		end if
		if (QUALIF(I)(1:3) .eq. 'DEL'  ) 
	1	QUALIFIER( left(QUALIFIER):)= '/DELETE'
		if (QUALIF(I)(1:3) .eq. 'DCL'  ) CODE = '9'
		if (QUALIF(I)(1:3) .eq. 'INS'  ) CODE = '7'
		if (QUALIF(I)(1:2) .eq. 'LO'   ) LOCAL=1
		if (QUALIF(I)(1:6) .eq. 'NOFORM'  ) 
	1	QUALIFIER( left(QUALIFIER):)= '/NOFORM'
		if (QUALIF(I)(1:6) .eq. 'NOFEED'  ) 
	1	QUALIFIER( left(QUALIFIER):)= '/NOFEED'
		if (QUALIF(I)(1:3) .eq. 'NOD'  ) LISTE_NOEUD= VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'NOE'  ) LISTE_NOEUD= VALEUR(I)
		if (QUALIF(I)(1:6) .eq. 'NOHEAD' ) 
	1	QUALIFIER( left(QUALIFIER):)= '/NOHEAD'
		if (QUALIF(I)(1:4) .eq. 'NOLO' ) LOCAL=0
		if (QUALIF(I)(1:3) .eq. 'NONOT') NOTIFY= ' '
		if (QUALIF(I)(1:3) .eq. 'NOT'  ) NOTIFY= 'NOTIFY'
		if (QUALIF(I)(1:2) .eq. 'OU'   ) FICHIER_OUT= VALEUR(I)
		if (QUALIF(I)(1:2) .eq. 'PR'   ) PROTECTION= VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'QUA'  ) QUALIFIER= VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'QUE'  ) QUEUE=	VALEUR(I)
		if (QUALIF(I)(1:3) .eq. 'QUE'  ) CODE = '5'
		if (QUALIF(I)(1:2) .eq. 'UI'   ) UIC_CIBLE= VALEUR(I)
		if (QUALIF(I)(1:2) .eq. 'WI'   ) Cluster_Wide= 'WIDE'
	enddo
	call CHECK_PROT( PROTECTION )
	if ( LISTE_NOEUD(1:3) .ne. 'ALL' .and.
	1	LISTE_NOEUD(1:5) .ne. 'WORLD' ) LOCAL= 1
	FICHIER_DEPART= PARAM(1)
	FICHIER_CIBLE = PARAM(2)
c
c	.... informations sur l'utilisateur et le noeud de depart
	call GETUSER( USERNAME )
	call P_JOUR( JOUR )
	call sys$trnlog( 'SYS$NOEUD',, LOCAL_NODE,,,)
	LOCAL_NODE= LOCAL_NODE(2: INDEX ( LOCAL_NODE, '::') - 1)
c--------------------------------------------------------
c
	if ( CODE(1:2) .eq. '99' ) then
c
c	**** cleans up SENDNET request with problems
c
c	/CODE=99    'request number' or *
c
	call CHECK_PRIV( LOCAL_NODE, MASTER_NODE, NB_MASTER_NODE, USERNAME )
	if ( FICHIER_DEPART .eq. ' ') then
		call sendnetin('request to clean up', FICHIER_DEPART, '*')
	endif
	FICHIER_DEPART_COMPLET= FICHIER_DEPART
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1			FICHIER_DEPART, 0,
	1			NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR )
c
c--------------------------------------------------------
c
	elseif ( CODE(1:2) .eq. '12' ) then
c
c	**** envoie pour CISI via un noeud du cluster
c
c	/CODE=12/COMMANDE=CISI FICHIER.DAT
c
	if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1	FICHIER_DEPART,
	1	0, NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR)
	if ( NB_NOEUD_CIBLE .gt. 1 ) then
		call sendnetin(' noeud de routage pour HSP ?', 
	1	NOEUD_CIBLE(1), ' ')
		NB_NOEUD_CIBLE=1
	endif
	if( LEFT0(COMMANDE) .eq. 0 ) COMMANDE= 'CISI'
	if( FICHIER_DEPART .eq. ' ' )
	1	call erreur ('la queue etant VIA un autre VAX, elle ne peut'
	1	//' pas etre consultee')
	ISTAT= lib$find_file( 
	1	FICHIER_DEPART, FICHIER_DEPART_COMPLET, ZERO )
	if( .not. ISTAT ) call erreur (' ce fichier n existe pas' )
	FICHIER_DEPART= FICHIER_DEPART_COMPLET
c	... construction du nom /OUT=
	if ( left0( FICHIER_OUT ) .eq. 0 ) then
c		FICHIER_OUT= FICHIER_DEPART(1: INDEX(FICHIER_DEPART,';')-5)
c		FICHIER_OUT= FICHIER_OUT(1:LEFT(FICHIER_OUT))//'.LIS'
		IPOS= MAX( index( FICHIER_DEPART, ']'),
	1		   index( FICHIER_DEPART, '>'))
		FICHIER_OUT= FICHIER_DEPART(1:IPOS) // 'RETOUR.LIS'
	else
		if ( index( FICHIER_OUT, ':' ) .eq. 0 )then
			IPOS= MAX( index( FICHIER_DEPART, ']'),
	1			   index( FICHIER_DEPART, '>'))
			FICHIER_OUT= FICHIER_DEPART(1:IPOS) // FICHIER_OUT
		endif
	endif
	if ( NB_NOEUD_CIBLE .GT. 1 ) 
	1	call erreur( 'un seul noeud cible est autoris{ pour code=10')
	KAS_COPY= 0
c
c--------------------------------------------------------
c	note that code 11 is used by sendnet3.com when returning lists
c	as a result of code 10
c--------------------------------------------------------
c
	elseif ( CODE(1:2) .eq. '10' ) then
c
c	**** envoie pour CISI
c
c	/CODE=10/COMMANDE=CISI FICHIER.DAT
c
	if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1	FICHIER_DEPART,
	1	0, NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR)
	if ( NB_NOEUD_CIBLE .gt. 1 ) then
		call sendnetin(' noeud de routage pour HSP ?', 
	1	NOEUD_CIBLE(1), ' ')
		NB_NOEUD_CIBLE=1
	endif
	if( LEFT0(COMMANDE) .eq. 0 ) COMMANDE= 'CISI'
	if( FICHIER_DEPART .eq. ' ' )
	1	call erreur ('la queue etant VIA un autre VAX, elle ne peut'
	1	//' pas etre consultee')
	ISTAT= lib$find_file( 
	1	FICHIER_DEPART, FICHIER_DEPART_COMPLET, ZERO )
	if( .not. ISTAT ) call erreur (' ce fichier n existe pas' )
	FICHIER_DEPART= FICHIER_DEPART_COMPLET
c	... construction du nom /OUT=
	if ( left0( FICHIER_OUT ) .eq. 0 ) then
		FICHIER_OUT= FICHIER_DEPART(1: INDEX(FICHIER_DEPART,';')-5)
		FICHIER_OUT= FICHIER_OUT(1:LEFT(FICHIER_OUT))//'.LIS'
	else
		if ( index( FICHIER_OUT, ':' ) .eq. 0 )then
			IPOS= MAX( index( FICHIER_DEPART, ']'),
	1			   index( FICHIER_DEPART, '>'))
			FICHIER_OUT= FICHIER_DEPART(1:IPOS) // FICHIER_OUT
		endif
	endif
c	... le nom suivant sera construit au moment de l'envoie
c	FICHIER_CIBLE= 'NETUSER$DEMANDES:'//FILENUMBER//'.DAT'
	if ( NB_NOEUD_CIBLE .GT. 1 ) 
	1	call erreur( 'un seul noeud cible est autoris{ pour code=10')
	KAS_COPY= 1
c
c--------------------------------------------------------
c
	elseif ( CODE(1:1) .eq. '9' ) then
c
c	**** $ COMMANDE for remote node
c
	call CHECK_PRIV( LOCAL_NODE, MASTER_NODE, NB_MASTER_NODE, USERNAME )
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1			FICHIER_DEPART, 0,
	1			NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR )
	if( COMMANDE(1:1) .eq. ' ' )
	1	call sendnetin('commande sans le $ ', COMMANDE, ' ')
c
c--------------------------------------------------------
c
	elseif ( CODE(1:1) .eq. '7' ) then
c
c	**** COPY followed by PURGE then INSTALL/REPLACE
c
c	/CODE=7 FICHIER_DEPART [FICHIER_CIBLE]   for copy then purge
c	
c	FICHIER_CIBLE MUST be a logical
c
	if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
	call CHECK_PRIV( LOCAL_NODE, MASTER_NODE, NB_MASTER_NODE, USERNAME )
	if ( FICHIER_DEPART .eq. ' ') then
		call sendnetin('fichier @ copier svp ?', FICHIER_DEPART, ' ')
		call sendnetin('fichier cible svp ?', FICHIER_CIBLE,
	1	FICHIER_DEPART)
	endif
	ISTAT= lib$find_file( FICHIER_DEPART, FICHIER_DEPART_COMPLET, 
	1		ZERO )
	if ( .not. ISTAT ) call erreur( 'ce fichier n''existe pas ') 
	call CHECK_LOGICAL ( FICHIER_DEPART, FICHIER_CIBLE ) ! check that target is a logical
	FICHIER_DEPART= FICHIER_DEPART_COMPLET
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1			FICHIER_DEPART, 1,
	1			NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR )
	KAS_COPY=1 		! request copy of input file
c
c--------------------------------------------------------
c
	else if ( CODE(1:1) .eq. '5' ) then
c
c	**** PRINT on a remote printer
c
c	/CODE=5/QUEUE=q  FICHIER_DEPART
c
	if ( FICHIER_DEPART(1:1) .eq. ' ')
	1	call sendnetin( 'fichier @ imprimer ? ', FICHIER_DEPART, ' ')
	if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
	call DEFAULT_EXT( FICHIER_DEPART, 'LIS' )
	ISTAT= lib$find_file( FICHIER_DEPART, FICHIER_DEPART_COMPLET, 
	1		ZERO )
	if ( .not. ISTAT ) call erreur( 'ce fichier n''existe pas ') 
	if ( QUEUE(1:1) .eq. ' ')
	1	call sendnetin('pour quelle imprimante svp ?', QUEUE, ' ')
	KAS_COPY= 1
	call VERIF_IMPR( QUEUE, NOEUD_CIBLE )
	FICHIER_CIBLE= QUEUE
	NB_NOEUD_CIBLE= 1
c
c--------------------------------------------------------
c
	elseif ( CODE(1:1) .eq. '3' ) then
c
c	**** COPY followed by PURGE then @ 
c
c	/CODE=3 FICHIER_DEPART [FICHIER_CIBLE]   
c	
c	FICHIER_CIBLE MUST be a logical
c
	call CHECK_PRIV( LOCAL_NODE, MASTER_NODE, NB_MASTER_NODE, USERNAME )
	if ( FICHIER_DEPART .eq. ' ') then
		call sendnetin('fichier @ copier puis enrouler svp ?', 
	1	FICHIER_DEPART, ' ')
		if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
		call sendnetin('fichier cible svp ?', FICHIER_CIBLE, 
	1	FICHIER_DEPART)
	endif
	ISTAT= lib$find_file( FICHIER_DEPART, FICHIER_DEPART_COMPLET, 
	1		ZERO )
	if ( .not. ISTAT ) call erreur( 'ce fichier n''existe pas ') 
	call CHECK_LOGICAL ( FICHIER_DEPART, FICHIER_CIBLE ) ! check that target is a logical
	FICHIER_DEPART= FICHIER_DEPART_COMPLET
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1			FICHIER_DEPART, 1,
	1			NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR )
	KAS_COPY=1 		! request copy of input file
c
c--------------------------------------------------------
c
	elseif ( CODE(1:1) .eq. '2' .or. CODE(1:1) .eq. '1' ) then
c
c	**** COPY followed by PURGE for CODE=1
c
c	/CODE=2 FICHIER_DEPART [FICHIER_CIBLE]   for copy then purge
c	/CODE=1 FICHIER_DEPART [FICHIER_CIBLE]   for copy alone
c	
c	FICHIER_CIBLE MUST be a logical
c
	if ( FICHIER_DEPART .eq. ' ') then
		call sendnetin('fichier @ copier svp ?', FICHIER_DEPART, ' ')
		call sendnetin('fichier cible svp ?', FICHIER_CIBLE,
	1	FICHIER_DEPART)
	endif
	if ( index ( FICHIER_DEPART , '*' ) .ne. 0 ) call erreur
	1	( 'un seul fichier @ la fois svp' )
	ISTAT= lib$find_file( FICHIER_DEPART, FICHIER_DEPART_COMPLET, 
	1		ZERO )
	if ( .not. ISTAT ) call erreur( 'ce fichier n''existe pas ') 
c	.... ! check that target is a logical
	call CHECK_LOGICAL ( FICHIER_DEPART, FICHIER_CIBLE ) 
	FICHIER_DEPART= FICHIER_DEPART_COMPLET
	call GET_NOEUD_CIBLE( LOCAL_NODE, LISTE_NOEUD, Cluster, Cluster_Wide,
	1			FICHIER_DEPART, 1,
	1			NOEUD_CIBLE, NB_NOEUD_CIBLE, IERR )
	KAS_COPY=1 		! request copy of input file
c
c--------------------------------------------------------
c
	else 
		call erreur(' code illegal')
	endif
99	continue
c--------------------------------------------------------
	call CHECK_NODE( LOCAL_NODE, NOEUD_CIBLE, NB_NOEUD_CIBLE,
	1		NOEUD_CIBLE2, NB_NOEUD_CIBLE2, IERR)
	if ( IERR .ne. 0 ) call erreur( 'mauvais noeuds cibles ')
	if ( LOCAL .eq. 0 ) call NO_LOCAL ( LOCAL_NODE, 
	1	NOEUD_CIBLE2, NB_NOEUD_CIBLE2, NOEUD_CIBLE, NB_NOEUD_CIBLE)
	do I= 1, NB_NOEUD_CIBLE
		call unique( FILENUMBER )
		NOM_DEMANDE = 'NETUSER$DEMANDES:' // FILENUMBER
		DEMANDE_NOD = NOM_DEMANDE(1:LEFT(NOM_DEMANDE))
	1				 // '.'//NOEUD_CIBLE(I)
		DEMANDE_DAT = NOM_DEMANDE(1:LEFT(NOM_DEMANDE))
	1				 // '.DAT'
		if( CODE .eq. '10' )
	1	FICHIER_CIBLE= 'NETUSER$DEMANDES:'//FILENUMBER//'.DAT'
c
		open ( unit=11, name=DEMANDE_NOD, type='new', 
	1		carriagecontrol='list', iostat=ISTAT )
		if ( ISTAT .eq. 0)then
			if ( KAS_COPY .eq. 1 ) then
				call copyfor( 
	1			FICHIER_DEPART(1:LEFT(FICHIER_DEPART)), 
	1			DEMANDE_DAT)
				call chprot( DEMANDE_DAT, 'EEE0'X, ISTAT )
			endif
c
	call out_line('01 demande numero   ', FILENUMBER)
	call out_line('02 date             ', JOUR)
	call out_line('03 noeud origine    ', 
	1	'_'//LOCAL_NODE(1:left(LOCAL_NODE))//'::')
c	.... above _ and :: should disappear later on 
	call out_line('04 code op{ration   ', CODE)
	call out_line('05 noeud cible      ', NOEUD_CIBLE(I))
	call out_line('06 UIC cible        ', UIC_CIBLE)
	call out_line('07 protections      ', PROTECTION)
	call out_line('08 fichier cible    ', FICHIER_CIBLE)
	call out_line('09 fichier depart   ', FICHIER_DEPART_COMPLET)
	call out_line('10 UIC depart       ', UIC_DEPART)
	call out_line('11 param}tres       ', QUALIFIER)
	call out_line('12 username         ', USERNAME)
	call out_line('13 Commande         ', COMMANDE)
	call out_line('14 Fichier out      ', FICHIER_OUT)
	call out_line('15 Notify           ', NOTIFY)
			close( unit=11 )
			call chprot( DEMANDE_NOD, 'EEE0'X, ISTAT )
			write( 6, *)'demande transmise pour le noeud ',
	1		NOEUD_CIBLE(I)
		else
			write( 6, *)'pb d''ouverture, contactez ASSISTANCE ',
	1		'en indiquant le message suivant'
			call exit ( ISTAT )
		endif
	enddo
c
	stop 'fin de sendnet'
	end