/*     * * * * *    A T O M I C . R E X X     * * * * *           */
/*                                                                */
/*      file: s:atomic.rexx                                       */
/*                                                                */
/*      by John Chufar                                            */
/*      ver 2.0.7    2 Nov  1999                                  */
/*      -Bug Fix(2) for DATE command (initialize minusday)        */
/*                                                                */
/* ************************************************************** */



startup:

/* initialize variables */

minusday = 0



/* init the command channel to AmigaDOS and see if TCP is mounted */

ADDRESS COMMAND

" Assign >NIL: TCP: exists "

IF RC = 5 THEN
   DO
      SAY ' TCP: not mounted ...read docs please... exiting  '
      SAY ''
      EXIT 10
   END

startupend:



debug:

/* Use TRACE only for debug--it is very time consuming! */
/* TRACE(I)  */

debugend:



titlescreen:

/* display the title screen ...   */

SAY ''
SAY ''
SAY '                 * * *   A T O M I C L O C K  * * *         '
SAY '                                                            '
SAY '                             Version 2.0.7                  '
SAY '                          1997, 1998, 1999                  '
SAY '                  "intelliserve" (TM) Technology ~ iT       '
SAY ''
SAY ''


/* argstring$ set module */

argstring$ = ''

numargs = ARG()  /* number of args */

IF numargs > 0 THEN ARG argstring$

titlescreenend:



/* defaults          */

servercount = 0
TIMEAVG. = 0.1



readconfig:


IF ~OPEN('cf','s:atomic.conf', 'R')
   THEN DO
      Say '*** Unable to open configuration file, atomic.conf'
      Exit 10
   END

DO WHILE ~EOF('cf')
   instring = READLN('cf')
   INTERPRET instring
   IF (INDEX(instring,'TIMESERVER') =1)
      THEN DO
      servercount = servercount + 1
   END
  END


clcode = CLOSE('cf')



readlog:


IF ~OPEN('lf',LOGFILE, 'R')
   THEN DO
      Say '*** Unable to open log file, ' LOGFILE
      Exit 10
   END


   SHOWAVG = '0'
   IF (AVG='YES') THEN SHOWAVG ='1'

   CMPA = 0
   CMPA = INDEX(argstring$,'A')

   IF CMPA > 0
      THEN DO
         SHOWAVG = '1'
      END


   DO i=1 TO servercount
      c=0
      timesum=0
      DO WHILE ~EOF('lf')
       logstring = READLN('lf')
       IF (INDEX(logstring,TIMESERVER.i) =1)
         THEN DO
            c = c + 1
            TIMESUM.c = WORD(logstring,2)
            timesum= TIMESUM.c + timesum
         END
      END
      seekcode = SEEK('lf',0,'B')
      IF (c > 0)
         THEN DO
           TIMEAVG.i = timesum / c
         END

       IF SHOWAVG > 0
         THEN DO
           AVGOUT$ = 'AVERAGE CONNECT TIME FOR 'TIMESERVER.i': '
           SAY OVERLAY(TIMEAVG.i,AVGOUT$,65,,'.')
         END
   END
   SAY ''

clcode = CLOSE('lf')



sortdata:

/* bubble sort the server data */


loop = servercount - 1

DO j = 1 to loop
   k = j+1
   DO l = k to servercount
      IF TIMEAVG.j > TIMEAVG.l
            THEN DO
               tempavg = TIMEAVG.j ; tempserv = TIMESERVER.j
               TIMEAVG.j = TIMEAVG.l; TIMESERVER.j = TIMESERVER.l
               TIMEAVG.l = tempavg; TIMESERVER.l = tempserv
            END
   END

END


IF ~OPEN('sf','t:sortfile', 'W')
   THEN DO
      Say '*** Unable to open temp sort file, t:sortfile'
      Exit 10
   END

   DO i=1 TO servercount
      outstring = TIMEAVG.i||' '||TIMESERVER.i
      wrcode = WRITELN('sf',outstring)
   END

clcode = CLOSE('sf')



logfile:

/* open the log file to append  */

IF ~Open('lf',LOGFILE, 'A')
   THEN DO
      Say '*** Unable to append to log file'
      Exit 10
   END



/* open the tcp channel to the host */

IF ~OPEN('sr','t:sortfile', 'R')
   THEN DO
      Say '*** Unable to open temp sortfile'
      Exit 10
   END



connect:


serverstart = TIME('E')

IF ~EOF('sr')
         THEN DO
            serverstring = READLN('sr')
            intelliserver = WORD(serverstring,2)
            intelliport = 'TCP:'||intelliserver||'/daytime'
         END
         ELSE DO
            SAY '*** NIST Time Services are not present...exiting'
            SAY ''
            SAY 'Try again at a later time.'
            SAY '**************************************'
            EXIT 10
         END


SAY 'Connecting to Atomic Clock server 'intelliserver

IF ~OPEN(dt,intelliport, 'R')
   THEN DO
      SAY 'Connection error with 'intelliserver
      serverend = TIME('E')
      logdaystring = DATE()
      logtimestring = TIME()
      serverelapsed = serverend - serverstart
      serverlog = intelliserver || "   " || serverelapsed ||"   "|| logdaystring ||" "||logtimestring

      wrcode = WRITELN('lf',serverlog)
      CALL connect
   END


serverend = TIME('E')
serverelapsed = serverend - serverstart
SAY 'Server connection time: ' serverelapsed



connectend:



decode:
/* get the atomic time from the open file 'dt'  */
  
d = readln(dt) /* dummy read...empty first line */
d = readln(dt)

serverhealth = WORD(d,6)
utcdst = WORD(d,4)

IF (serverhealth ~= 0)
   THEN DO
      SAY "Server Health: " serverhealth " insufficient...trying next server."
      SAY ''
      CALL connect
   END

SAY "Server Health: " serverhealth " (Excellent)"


tim = SubWord(d, 3, 1)

utcdate=SubWord(d,2,1)

utcday=SubStr(utcdate,7,2)
utcmonth=SubStr(utcdate,4,2)
utcyear=SubStr(utcdate,1,2)

decodend:



oldtime = TIME('N')

/* changed in 1.5 from DATE('B') */

olddate = DATE('I')

'Date TIME ' tim ' DATE ' utcday"-"utcmonth"-"utcyear
'Date'



calculate_timezone:


/*      Script to offset the time to local                        */
/*      and calculates your localtime 'error'                     */

IF ~(Exists('env:sys/locale.prefs'))
   THEN DO
     Say 'Fatal error *** Env:sys/locale.prefs does not exist ***'
     Exit 10
   END

IF ~Open(pf, 'env:sys/locale.prefs', 'R')
   THEN DO
      SAY '*** Unable to open prefs file'
      Exit 10
   END

dummy = SEEK(pf,384,'B')

d = readch(pf,2)
tzoval = C2D(d)

/* tzoval is the timezone offset in minutes */

gmtflag = 0

IF tzoval > 660      /* if the timeszone is > international date line */
   THEN DO
   tzoval = 65536 - tzoval       /* reverse offset (12 hours or greater */
   tzocalc = tzoval/60           /* convert to hours.decimins */
   tzocalc = TRUNC(tzocalc,2)    /* hours.mm format */
   tzohour = TRUNC(tzocalc)      /* hours */
   tzomin  = RIGHT(tzocalc,2)    /* extract minutes */
   tzomin  = tzomin * .6         /* convert decimal to minutes */
   tzomin  = TRUNC(tzomin)       /* discard decimals (seconds) */
   tzohour = 24 - tzohour        /* complete the offset */
   if tzomin > 0 THEN tzohour = tzohour -1
   gmtflag = 1
   END


IF gmtflag = 0      /* if the timezone is < 12 hours fom GMT */
   THEN DO
   tzocalc = tzoval/60           /* convert to hours.decimins */
   tzocalc = TRUNC(tzocalc,2)    /* hours.mm format */
   tzohour = TRUNC(tzocalc)      /* hours */
   tzomin  = RIGHT(tzocalc,2)    /* extract minutes */
   tzomin  = tzomin * .6         /* convert decimal to minutes */
   tzomin  = TRUNC(tzomin)       /* discard decimals (seconds) */
   END


IF (utcdst = '00') | (utcdst > '50') THEN TIMECODE = 'STANDARD'
IF (utcdst > '00') & (utcdst < '51') & (DST='YES')  THEN TIMECODE = 'DAYLIGHT'


/* if user enters y or n, this overrides the DST in config file */
/* and the calulcated DST from the timeserver                   */

CMPY = INDEX(argstring$,'Y')

IF CMPY > 0
   THEN DO
      TIMECODE = 'DAYLIGHT'
   END

CMPN = INDEX(argstring$,'N')

IF CMPN > 0
   THEN DO
      TIMECODE = 'STANDARD'
   END


IF (TIMECODE = 'DAYLIGHT')
   THEN DO
      tzohour = tzohour -1
   END

/* read current system time and extract hours and minutes */

timestring = TIME('N')
mins = SUBSTR(timestring,4,2)
hour = LEFT(timestring,2)

newmins = mins - tzomin
IF newmins < 0
   THEN DO
   newmins = newmins + 60        /* positive value for minutes */
   tzohour = tzohour + 1         /* borrow an hour for substraction */
   END


offset = tzohour  /* set for Your Time Zone */
localhour = hour - offset

localhour=hourcheck(localhour)


/* Routine for DAY of CHANGE at 0200 local when servers return 01 or 51 */
/* for the DST field */

IF ((TIMECODE='DAYLIGHT') & (CMPY < 1))
   THEN DO
      IF ((localhour>2) & (utcdst='01'))
         THEN DO
            localhour = localhour - 1
            tzohour = tzohour + 1
         END
   END

IF ((TIMECODE='STANDARD') & (CMPN < 1) & (DST='YES'))
   THEN DO
      IF ((localhour>2) & (utcdst='51'))
         THEN DO
            localhour = localhour + 1
            tzohour = tzohour - 1
         END
   END

localhour=hourcheck(localhour)


tzoff$ = "-" || tzohour

IF tzohour > 12
   THEN DO
    tzoff = 24 - tzohour
     IF tzomin > 0 THEN tzoff = tzoff -1  /* Compensate for half hour zones */
    tzoff$ = "+" || tzoff
   END


SAY 'Time adjusted '|| tzoff$ ||' hours and ' tzomin ' minutes from UTC.'
SAY ''

newhour = localhour


/* correct for hours and minutes of one character '<10'  */

IF localhour <10 THEN newhour = "0" || localhour
IF newmins < 10 THEN newmins = "0" || newmins


/* create the new time string */

newtime = newhour || ":" || newmins ||SUBSTR(timestring,6,3)


/* Correct for the date  */
IF (minusday = 0) & (gmtflag = 1) THEN 'DATE TOMORROW'
IF (minusday = 1) & (gmtflag = 0) THEN 'DATE YESTERDAY'
/* ELSE leave the data as TODAY */


/*  AmigaDOS DATE commands  */

'DATE TIME ' || newtime

'DATE'

'SetClock SAVE'
SAY ''


/* changed in 1.5 from DATE('B')  */
newdate = DATE('I')



/* Compensation for initial clock read                 */
/* Adjust by adding 1 second due to program exec time  */
/* Average exec time was .56 seconds on A3000 25MHz    */

adjustment:

adjsec = RIGHT(oldtime,2)
adjmin = SUBSTR(oldtime,4,2)
adjhour = LEFT(oldtime,2)

adjsec = adjsec + 1

   IF adjsec > 59 THEN
      DO
          adjsec = 0
          adjmin = adjmin + 1
            IF adjmin > 60 THEN
               DO
                  adjmin = 0
                  adjhour = adjhour + 1
                     IF adjhour > 23 THEN
                        DO
                           adjhour = 0
                           olddate = olddate + 1
                         END
               END
      END

/* ensures values are converted to integer types */

adjsec = adjsec + 0
adjmin = adjmin + 0
adjhour = adjhour + 0



adjsecstr$  = adjsec
IF adjsecstr$ = '0' THEN adjsecstr$ = '00'
IF (adjsec > 0 ) & (adjsec < 10) THEN adjsecstr$ = '0' || adjsecstr$

adjminstr$ = adjmin
IF adjminstr$ = '0' THEN adjminstr$ = '00'
IF (adjmin > 0 ) & (adjmin < 10) THEN adjminstr$ = '0' || adjminstr$

adjhourstr$ = adjhour
IF adjhourstr$ = '0' THEN adjhourstr$ = '00'
IF (adjhour > 0 ) & (adjhour < 10) THEN adjhourstr$ = '0' || adjhourstr$

oldtime = adjhourstr$||':'||adjminstr$||':'||adjsecstr$

adjustmentend:



oldtimesecs = timeseccalc(oldtime)
newtimesecs = timeseccalc(newtime)


SAY ' Previous System time was: ' oldtime
SAY ' Current System time is  : ' newtime

oldsecs =  (olddate *  86400) + oldtimesecs
newsecs =  (newdate * 86400)  + newtimesecs


secdiff = newsecs - oldsecs

secdiff  =  ABS(secdiff)

datediff = TRUNC(secdiff / 86400)

compsecdiff = secdiff - (datediff * 86400)

diffstr$ = timediff(compsecdiff)

/* datediff = newdate - olddate */
/* datediff = ABS(datediff)     */

SAY ''
SAY ' Time difference was ' datediff ' days and 'diffstr$
SAY ''

logdiff$ = "  "||datediff||" days  "||diffstr$

/* log successful connection information */

logdaystring = DATE()
logtimestring = TIME()

serverlog = intelliserver || "   " || serverelapsed ||"   "|| logdaystring ||"   "||logtimestring||logdiff$
wrcode = WRITELN('lf',serverlog)

clcode =  CLOSE('lf')


EXIT


/* ******************  TIME CALC  MODULE   **************   */

/* Function to calc timesecs */
timeseccalc: procedure
 ARG timestring

 SECS = RIGHT(timestring,2)
 MINS = SUBSTR(timestring,4,2)
 HOURS = LEFT(timestring,2)

timesecs = (HOURS * 3600) + (MINS * 60) + (SECS)

RETURN timesecs


/* Function to converts seconds into HH:MM:SS format */
timediff: procedure
 ARG timenumsecs

   hours = timenumsecs % 3600
   hoursecs = hours * 3600
   mins = (timenumsecs - (hoursecs)) % 60
   minsecs = mins * 60
   secs = timenumsecs - hoursecs - minsecs

   hourstr$ = hours
   IF (hours < 10) THEN hourstr$ = '0' || hours
   minstr$ = mins
   IF (mins < 10)  THEN minstr$ = '0' || mins
   secstr$ = secs
   IF (secs < 10)  THEN secstr$ = '0' || secs

   timeconvstr$ = hourstr$||':'||minstr$||':'||secstr$


 RETURN timeconvstr$

/* Function to check hours */
/* EXPOSE added in v2.0.7 */
hourcheck: procedure EXPOSE minusday gmtflag localhour
 ARG localhour

IF localhour <0
 THEN  DO
     localhour = localhour + 24
     minusday = 1
 END


/* added for 2.0.3 version */
/* can ONLY happen if living in GMT zone with DST in effect */

IF localhour > 23
 THEN  DO
     localhour = localhour - 24
     gmtflag = 1
 END

   RETURN localhour


/* ****************   E N D   O F   P R O G R A M   ****************** */
