program dialer
c
c	Written by- Patrick T. McDonald   28-Oct-87
c
c	Program to auto-dial a remote dial-out Hayes compatible modem.
c

c
c	Get symbol definitions
c
	include '($syssrvnam)'
	include '($iodef)'
	include '($ssdef)'
	include '($libdef)'
	include '($ttdef)'
	include '($tt2def)'
	include '($dcdef)'
	include 'dialer_config.inc'

c
c	General IOSB Structure
c
	structure /iosb1/
	   
	   integer*2	cvalue,bytcnt
	   integer*4	devdep

	end structure

c
c	Sense Mode IOSB
c
	structure /iosb2/

	   integer*2	status
	   byte		tspeed,rspeed
	   byte		crfill,lffill,pflags,null

	end structure

c
c	Terminal Set Mode Characteristics Buffer
c
	structure /tsms/

	   byte class
	   byte type
	   integer*2 width
	   integer*4 bchar,echar

	end structure
c
c	Local Declarations
c

	logical submit
	integer status,strlen
	character pver*5,pdate*9,mdmbuf*132,phone*12,line*132

	record /iosb1/ iosb
	record /iosb2/ iosbsm
	record /tsms/ tsmb

	pver = '1.10'
	pdate = '12-Dec-89'

	type 10,pver,pdate
10	format(/' *** CMRSD Auto-Dialer v',a,' ',a,' ***'/)
c
c	Read out configuration parameters
c
	open(unit=1,name='DIALER_CONFIG',type='OLD',readonly,err=20)
	goto 30

20	type 15
15	format(' %DIALER-F-NOCFG,  Unable to open DIALER.DAT')
	call sys$exit(%val(0))

30	read(1,35)config.mdmprt, config.mdmini, config.mdmans,
     -	          config.mdmnan, config.mdmpre, config.mdmsuf,
     -	          config.ddelay, config.pdelay, config.debug
35	format(a/a/a/a/a/a/a/a/a/a/a/a/i/i/l)
	goto 50

40	type 45
45	format(' %DIALER-F-BADCFG, Error reading DIALER.CFG')
	call sys$exit(%val(0))

50	close(unit=1)

c
c	Display the configuration parameters
c

	type 60
60	format(' %DIALER-I-GOTCFG, DIALER configuration read')

	type 70,config.mdmprt, config.mdmini, config.mdmans,
     -	        config.mdmnan, config.mdmpre, config.mdmsuf,
     -	        config.ddelay, config.pdelay, config.debug
70	format(/' CMRSD Dialer Configuration Parameters'//
     -	' Modem Port: ',a/' Modem Init: ',a/
     -	' Connect Strings: ',a/3(' ',17x,a/)/
     -	' Failure Strings: ',a/3(' ',17x,a/)/
     -	' Dialing Prefix:  ',a/
     -	' Dialing Suffix:  ',a/
     -	' Dialing Delay: ',i2,' secs'/
     -	' Pause Delay:   ',i2,' secs'/
     -	' Debug Flag:     ',l/)

c
c	Allocate the port
c

	status = sys$alloc(config.mdmprt,,,,)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	if(config.debug)then
	   type 75,config.mdmprt
75	   format(' %DIALER-I-ALLOC,  Port Allocated: ',a)
	endif

c
c	Assign an I/O channel to it
c

	status = sys$assign (config.mdmprt, config.mdmchn,,)
	if(status.ne.ss$_normal) call sys$exit(%val(status))

	if(config.debug)then
	   type 80,config.mdmchn
80	   format(' %DIALER-I-IOCHAN, Assign I/O Channel:',i)
	endif

c
c	Get an event flag to use for timed I/O to the modem
c

	status=lib$get_ef(config.mdmefn)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	if(config.debug)then
	   type 90,config.mdmefn
90	   format(' %DIALER-I-MDMEFN, Allocate Event Flag: ',i2)
	endif

c
c	Get terminal characteristics
c
	status = sys$qiow(%val(config.mdmefn),%val(config.mdmchn),
     -	%val(IO$_SENSEMODE),iosbsm,,,tsmb,%val(12),,,,)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

c
c	Set the ones that we care about
c
	tsmb.bchar = ibset(tsmb.bchar,tt$v_modem)
	tsmb.bchar = ibset(tsmb.bchar,tt$v_nobrdcst)
	tsmb.bchar = ibset(tsmb.bchar,tt$v_noecho)

c	tsmb.bchar = ibclr(tsmb.bchar,tt$v_eightbit)
c	tsmb.bchar = ibclr(tsmb.bchar,tt$v_escape)
c	tsmb.bchar = ibclr(tsmb.bchar,tt$v_lower)
c	tsmb.bchar = ibclr(tsmb.bchar,tt$v_notypeahd)
c	tsmb.bchar = ibclr(tsmb.bchar,tt$v_readsync)
	tsmb.bchar = ibclr(tsmb.bchar,tt$v_wrap)
c
c	Extended Characteristics
c
c	tsmb.echar = ibset(tsmb.echar,tt2$v_modhangup)

	tsmb.echar = ibclr(tsmb.echar,tt2$v_autobaud)
c	tsmb.echar = ibclr(tsmb.echar,tt2$v_hangup)
	tsmb.echar = ibclr(tsmb.echar,tt2$v_pasthru)

	accept *,ibaud
	isetbd = tt$c_baud_1200
	if(ibaud.eq.300)then
	   isetbd = tt$c_baud_300
	elseif(ibaud.eq.1200)then
	   isetbd = tt$c_baud_1200
	elseif(ibaud.eq.2400)then
	   isetbd = tt$c_baud_2400
	elseif(ibaud.eq.9600)then
	   isetbd = tt$c_baud_9600
	elseif(ibaud.eq.19200)then
	   isetbd = tt$c_baud_19200
	endif

	status = sys$qiow(%val(config.mdmefn),%val(config.mdmchn),
     -	%val(io$_setmode),iosbsm,,,tsmb,%val(12),%val(isetbd),,,)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	if(config.debug)then
	   type 100
100	   format(' %DIALER-I-SETPRT, Modem Port Characteristics',
     -	   ' Configured')
	endif

	if(submit('AT')) then
	   if(config.debug)then
	      type 110
110	      format(' %DIALER-I-SUBMIT, Modem forced into submission')
	   endif
	endif

	m = strlen(config.mdmini)
	n = 0
	mdmbuf = ' '

	do i=1,m

	   if(config.mdmini(i:i).eq.'|')then
	      if(.not.submit(mdmbuf))then
	         type 120
120	         format(' %DIALER-F-NOINIT, Modem Initialization ',
     -	                'Failure')
		 call sys$exit(%val(0))
	      endif
	      n = 0
	      mdmbuf = ' '
	   else
	      n = n + 1
	      mdmbuf(n:n) = config.mdmini(i:i)
	   endif

	enddo

	if(n.gt.0)then
	   if(.not.submit(mdmbuf))then
	      type 120
	      call sys$exit(%val(0))
	   endif
	endif

	type 130
130	format(' %DIALER-I-MDINIT, Modem Initialized')

	accept 210,phone
210	format(a)

	type 220,phone(1:strlen(phone))
220	format(' %DIALER-I-NUMBER, Attempting to call ',a)

	n1 = strlen(config.mdmpre)
	n2 = strlen(config.mdmsuf)
	n3 = strlen(phone)

	mdmbuf = config.mdmpre(1:n1)//phone(1:n3)//
     -	config.mdmsuf(1:n2)//char(13)

	call clrtab

	call outmdm(mdmbuf,strlen(mdmbuf))

300	llen=132
	call inmdm(mdmbuf,llen,.false.,config.ddelay,status)

	if(status.ne.ss$_normal)goto 400

	do i=1,4

	   line = config.mdmans(i)(1:strlen(config.mdmans(i)))
	   llen = max(strlen(line),1)

	   if(index(mdmbuf,line(1:llen)).ne.0.and.line(1:1).ne.' ')then
	      type 310,mdmbuf(1:strlen(mdmbuf))
310	      format(' %DIALER-I-CONNCT, Modem: ',a)
	      call sys$exit(%val(ss$_normal))
	   endif

	   line = config.mdmnan(i)(1:strlen(config.mdmnan(i)))
	   llen = max(strlen(line),1)

	   if(index(mdmbuf,line(1:llen)).ne.0.and.line(1:1).ne.' ')then
	      goto 400
	   endif

	enddo

	goto 300

400	type 410
410	format(' %DIALER-F-NOANS,  Remote System Not Listening')

	call sys$exit(%val(ss$_abort))
	   
	end


c
c	Subroutine to hibernate a specified number of seconds
c
	subroutine hiber(delta)

	include '($syssrvnam)'
	include '($ssdef)'
	include 'dialer_config.inc'

	integer*4 delta,hour,min,secs,status
	character *13 tstr
	real*8 timadr

	secs = delta
	hour = secs/3600
	min = (secs - hour*3600)/60
	secs = secs - hour*3600 - min*60

	encode(13,10,tstr)hour,min,secs
10	format('0 ',i2,':',i2,':',i2,'.00')

	do i=3,13
	   if(tstr(i:i).eq.' ')tstr(i:i)='0'
	enddo

	if(config.debug)then
	   type 20,tstr
20	   format(' %DIALER-I-HIBER,  Hibernating delta time: ',a)
	endif

	status = sys$bintim(tstr,timadr)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	status = sys$schdwk (,,timadr,)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	status = sys$hiber()
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	return

	end


c
c	Subroutine to write a buffer to the modem
c
	subroutine outmdm(buffer,llen)

	include '($syssrvnam)'
	include '($ssdef)'
	include '($iodef)'
	include 'dialer_config.inc'

	integer*4 status
	character *(*) buffer

	status = sys$qiow(%val(config.mdmefn),%val(config.mdmchn),
     -	%val(io$_writelblk .or. io$m_noformat),,,,%ref(buffer),
     -	%val(llen),,,,)
	if(status.ne.ss$_normal)call sys$exit(%val(status))

	if(config.debug)then
	   type 10,llen,buffer(1:llen)
10	   format(' %DIALER-I-WRITEL, Count Written To Modem: ',i2/
     -	   ' Line:'/' ',a)
	endif

	return

	end

c
c	Subroutine to read a line of input from the modem
c
	subroutine inmdm(buffer,llen,flg,tmo,status)

	include '($syssrvnam)'
	include '($ssdef)'
	include '($iodef)'
	include 'dialer_config.inc'

	logical pflag,flg
	integer*4 status,pset,tmo
	character*3 yesno
	character*(*) buffer

	structure /iosb1/

	   integer*2	status,offset,term,terms

	end structure

	record /iosb1/ iosbrd

	pflag = flg
	pset = 0
	yesno=' NO'
	if(pflag)then
	   pset = io$m_purge
	   yesno = 'YES'
	endif

	if(config.debug)then
	   type 5,len(buffer),llen,yesno,tmo
5	   format(/' %DIALER-I-READRQ, Modem Read Request Parameters'//
     -	   ' Length of Buffer: ',i3/
     -	   ' Passed Length:    ',i3/
     -	   ' Purge Flag:       ',a3/
     -	   ' Timeout Value:    ',i3/)
	endif


	status = sys$qiow(%val(config.mdmefn),%val(config.mdmchn),
     -	%val(io$_readlblk .or. io$m_cvtlow .or. io$m_timed .or.
     -	io$m_trmnoecho .or. pset),iosbrd,,,%ref(buffer),%val(llen),
     -	%val(tmo),,,)

	if(iosbrd.status .eq. ss$_timeout)then
	   status = ss$_timeout
	   if(config.debug)then
	      type 10
10	      format(' %DIALER-W-TIMOUT, Modem Read Timed Out')
	   endif
	endif

	if(status.ne.ss$_normal.and.status.ne.ss$_timeout)
     -	call sys$exit(%val(status))

	llen = iosbrd.offset

	if(config.debug)then
	   type 20,buffer(1:llen),llen
20	   format(' %DIALER-I-RSPNCE, Modem Response:'/' ',a/
     -	   ' %DIALER-I-NCHARS, Number of Characters: ',i3)
	endif


	return

	end


c
c	Function to attempt to force the modem into submission
c
	logical function submit(sbuf)

	parameter (maxcnt=10)

	include '($syssrvnam)'
	include '($ssdef)'
	include '($iodef)'
	include 'dialer_config.inc'

	structure /tahs/

	   integer*2	count
	   byte		nxtchr
	   byte		reserv(5)

	end structure

	record /tahs/ tah

	integer*4 status,count,slen,strlen,rstat
	character*(*) sbuf
	character*132 locbuf


	count=0


10	count = count+1

	if(config.debug)then
	   type 15,count
15	   format(' %DIALER-I-TRYSUB, Attempting submission, Count: ',i2)
	endif
c
c	Cycle DTR
c
	call setdtr(.false.)
	call hiber(2)
	call setdtr(.true.)
	call hiber(2)

	if(config.debug)then
	   type 17
17	   format(' %DIALER-I-HANGUP, DTR Cycled Successfully')
	endif

c
c	Write the submission string
c
c	locbuf = char(13)//sbuf(1:strlen(sbuf))//char(13)
	locbuf = sbuf(1:strlen(sbuf))//char(13)
	slen = strlen(locbuf)

	call outmdm(locbuf,slen)
c
c	Read the response
c
18	locbuf = ' '
	llen = 132
	call inmdm(locbuf,llen,.false.,10,rstat)

	if(index(locbuf,'OK').ne.0)then
	   submit = .true.
	   return
	endif

	if(rstat.eq.ss$_normal)goto 18

	if(count.lt.maxcnt)goto 10

	submit = .false.

	type 20,maxcnt
20	format(' %DIALER-W-NOSBMT, Unable to force modem into',
     -	' submission: ',i2)

	return
	end


c
c	Subroutine to set/reset DTR
c
	subroutine setdtr(dtron)

	include '($syssrvnam)'
	include '($ssdef)'
	include '($iodef)'
	include 'dialer_config.inc'

	logical dtron
	integer*4 status

	structure /mms/

	   integer*2	dummy1
	   byte		mdmon, mdmoff
	   integer*4	dummy2

	end structure

	record /mms/ signal

	if(dtron)then
	   signal.mdmon = tt$m_ds_dtr
	else
	   signal.mdmoff = tt$m_ds_dtr
	endif

	status = sys$qiow (%val(config.mdmefn),%val(config.mdmchn),
     -	%val(io$_setmode .or. io$m_set_modem .or. io$m_maint),,,,
     -	%ref(signal),,,,,)

	if(.not.dtron)then
	   if(config.debug)then
	      type 10
10	      format(' %DIALER-I-DTRLO,  DTR Set Low')
	   endif
	else
	   if(config.debug)then
	      type 20
20	      format(' %DIALER-I-DTRHI,  DTR Set High')
	   endif
	endif

	return

	end

c
c	Function to calculate the "real" length of a character
c	string.
c
	integer function strlen(buffer)

	character*(*) buffer

	do i=len(buffer),1,-1
	   if(buffer(i:i).ne.' ')then
	      strlen = i
	      return
	   endif
	enddo

	strlen = 0

	return

	end

c
c	Subroutine to clear the typeahead buffer
c
	subroutine clrtab

	include 'dialer_config.inc'

	character*1 inbuf

	llen = 1
	call inmdm(inbuf,llen,.true.,1,istat)

	if(config.debug)then
	   type 10
10	   format(' %DIALER-I-PURGED, Modem Typeahead Purged')
	endif

	return

	end