Return to the FTP Tips
Syncronize AS/400 time with a NIST time server
Submitted by PDrula (at) covenanthouse (dot) org
Hi!
I guess the code is to big to be posted so i've attached a file.
The idea is not mine, i've got from somewhere but i just don't remember were - therefore i can not take credit for everything :).
/*?**************************************************************?*/
/*?1.?Create a dummy file for the compile requirement. */
/* CRTPF FILE(QTemp/FtpTimeLog) RCDLEN(132)? */
/*?2.?Add a new memebr to QTXTSRC in QGPL called FtpTimeCmd */
/* ?If you don't have QTXTSRC source file do: */
/* CRTSRCPF FILE(QGPL/QTXTSRC) MBR(FtpTimeCmd) ? */
/*?3.?Add one records to member FtpTimeCmd: */
/* quit? */
/*?4.?Create CLLE program: */
/* CRTBNDCL PGM(QGPL/FTP_TIME) SRCFILE(QGPL/QCLSRC) LOG(*YES)? */
/*?**************************************************************?*/
/* */
/* FTP to one of the time servers used by the NIST Internet Time */
/* Service (ITS) and capture the text, which contains the current */
/* UTC time. Then set the system time. */
/* See http://www.boulder.nist.gov/timefreq/service/time-servers.html */
/* */
/* The table below lists the time servers used by the NIST Internet */
/* Time Service (ITS). */
/* The table lists each server name, IP address, and location. */
/* It is probably safest to use the IP addresses instead of the domain */
/* names when accessing them. */
/* See http://www.boulder.nist.gov/timefreq/service/time-servers.html */
/* */
/* They all work using STRTCPFTP Port 13, from what i've seen, without */
/* having to enter a user name and password. */
/* Gotta try UDP port 123 - (using NTP format) */
/* */
/*?Name IP Location */
/*?=========================== ============== ========================= */
/*time-a.nist.gov? ?129.6.15.28 ?NIST, Gaithersburg, */
/* ?Maryland */
/*time-b.nist.gov? ?129.6.15.29 ?NIST, Gaithersburg, */
/* ?Maryland */
/*time-a.timefreq.bldrdoc.gov?132.163.4.101 ?NIST, Boulder, Colorado */
/*time-b.timefreq.bldrdoc.gov?132.163.4.102 ?NIST, Boulder, Colorado */
/*time-c.timefreq.bldrdoc.gov?132.163.4.103 ?NIST, Boulder, Colorado */
/*utcnist.colorado.edu? ?128.138.140.44?University of Colorado, */
/* ?Boulder */
/*time.nist.gov? ?192.43.244.18 ?NCAR, Boulder, Colorado */
/*time-nw.nist.gov? ?131.107.1.10 ?Microsoft, Redmond, */
/* ?Washington */
/*nist1.datum.com? ?66.243.43.21 ?Datum, San Jose, */
/* ?California */
/*nist1-dc.glassey.com? ?216.200.93.8 ?Abovenet, Virginia */
/*nist1-ny.glassey.com? ?208.184.49.9 ?Abovenet, New York City */
/*nist1-sj.glassey.com? ?207.126.98.204?Abovenet, San Jose, */
/* ?California */
/*nist1.aol-ca.truetime.com? ?207.200.81.113?TrueTime, AOL facility, */
/* ?Sunnyvalle, California */
/*nist1.aol-va.truetime.com? ?205.188.185.33?TrueTime, AOL facility, */
/* ?Virginia */
/* */
/********************************************************************** */
/* Note: Job must run with authority that can CHGSYSVAL QTIME */
/* This program requires you correctly set the SYSVAL */
/* QUTCOFFSET for your time zone. */
/* Go to http://nist.time.gov to see the time zone offset value. */
/* */
/* It is scheduled to run in the System Job Scheduler (WRKJOBSCDE) */
/* each SunDay, at 02:00AM, as follow: */
/* */
/* Frequency . . . . . . . . . . . FRQ *WEEKLY */
/* Schedule date, or . . . . . . . SCDDATE *NONE */
/* Schedule day . . . . . . . . . . SCDDAY *SUN */
/* + for more Values */
/* Schedule time . . . . . . . . . SCDTIME '02:00:01' */
/* */
/*******************************************************************/
/* That's it, folks! */
/* If T1 line goes down (GLOBIX), all bets are off! */
/* */
/* (man, i didn't write so much comments in ages! Hey, watta heck, */
/* wifey's still cooking the turkey :) */
/*******************************************************************/
PGM
/*?Local Variables?*/
Dcl Var(&Update) Type(*LGL) Value('1') /* Switch +
0=no update, 1=update */
Dcl Var(&DST) Type(*Lgl) Value('1') /* Switch +
0 = No Daylight Savings Time +
1 = Daylight Savings Time */
Dcl Var(&Target_Sys) Type(*Char) Len(30)
Dcl Var(&UTCSysVal) Type(*Char) Len(5)
Dcl Var(&UTC) Type(*Dec) Len(2 0)
Dcl Var(&UTCSign) Type(*Char) Len(1)
Dcl Var(&HH) Type(*Char) Len(2)
Dcl Var(&MM) Type(*Char) Len(2)
Dcl Var(&SS) Type(*Char) Len(2)
Dcl Var(&HH#) Type(*Dec) Len(2 0)
Dcl Var(&Time) Type(*Char) Len(6)
Dcl Var(&QTime) Type(*Char) Len(6)
Dcl Var(&TargetSys#) Type(*Dec) Len(2 0)
Dcl Var(&Check_By) Type(*Char) Len(2) Value('IP')
Dcl Var(&MsgDta) Type(*Char) Len(256)
/*?Retrieve program name / library Variables?*/
DCL VAR(&PgmInfo) TYPE(*CHAR) LEN(80)
DCL VAR(&PgmName) TYPE(*CHAR) LEN(10)
DCL VAR(&PgmLib) TYPE(*CHAR) LEN(10)
/*?QCLSCAN Variables?*/
Dcl Var(&String) Type(*Char) Len(132)
Dcl Var(&StrLen) Type(*Dec) Len(3 0) Value(132)
Dcl Var(&StrPos) Type(*Dec) Len(3 0) Value(1)
Dcl Var(&Pattern) Type(*Char) Len(1) +
Value(':')
Dcl Var(&PatLen) Type(*Dec) Len(3 0) Value(1)
DCL VAR(&UTCNIST) TYPE(*CHAR) LEN(9) +
Value('UTC(NIST)')
DCL VAR(&UTCNISTLen) TYPE(*DEC) LEN(3 0) Value(9)
Dcl Var(&Translate) Type(*Char) Len(1) Value('0')
Dcl Var(&Trim) Type(*Char) Len(1) Value('0')
Dcl Var(&Wild) Type(*Char) Len(1) Value(' ')
Dcl Var(&Result) Type(*Dec) Len(3 0) Value(1)
/*?QUTCOFFSET Variable?*/
Dcl Var(&DayOfWeek) Type(*CHAR) Len(4)
DCL VAR(&Month) TYPE(*CHAR) LEN(2)
DCL VAR(&Day) TYPE(*CHAR) LEN(2)
DCL VAR(&QHour) TYPE(*CHAR) LEN(2)
/*?File in QTEMP that will be parsed for time string?*/
DclF File(FtpTimeLog)
/********************************************************************/
/*? Let's begin ?*/
/*?Get this program name and library is in?*/
ChgVar Var(%bin(&PgmInfo 1 4)) Value(80)
ChgVar Var(%bin(&PgmInfo 5 4)) Value(80)
ChgVar Var(%bin(&PgmInfo 9 4)) Value(0)
ChgVar Var(%bin(&PgmInfo 13 4)) Value(0)
CallPrc Prc('_MATPGMNM') Parm(&PgmInfo)
ChgVar Var(&PgmLib) Value(%sst(&PgmInfo 19 10))
ChgVar Var(&PgmName) Value(%sst(&PgmInfo 51 10))
/*?First, check for internet access. I've though is very unlikely ?*/
/*?that Yahoo and Google are both down (but one never knows :) ?*/
/*?We can not ping the time server(s), since not all of them ?*/
/*?respond to ping. ?*/
Ping RmtSys(Yahoo.com) MsgMode(*Quiet *Escape)
/*?If no response, give it one more try?*/
MonMsg MsgID(TCP3210) Exec(Do)
Ping RmtSys(Google.com) MsgMode(*Quiet *Escape)
MonMsg MsgID(TCP3210) Exec(Do)
/*?No internet access. Send message and split?*/
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) MsgDta('There +
is no internet access from AS/400.') +
ToUsr(*SYSOPR) MsgType(*ESCAPE)
GoTo CmdLbl(ThaEnd)
EndDo
EndDo
/*?Create a temporary file to hold errors, if any ?*/
DltF File(QTEMP/FtpTimeErr)
MonMsg MsgID(CPF0000)
CrtPF File(QTEMP/FtpTimeErr) RcdLen(132) +
Mbr(FtpTimeErr)
Set_Target:
/*?All targets system were checked?*/
If Cond(&TargetSys# = 14) Then(Do)
/*?No target system responded by IP or name, send error?*/
If Cond(&Check_By = ' ') Then(GoTo CmdLbl(Error))
/*?Reset target system number and check by name?*/
Chgvar Var(&TargetSys#) Value(0)
Chgvar Var(&Check_By) Value(' ')
EndDo
Chgvar Var(&TargetSys#) Value(&TargetSys# + 1)
/*?If Target System > 1 then log errors from previous attempt ?*/
If Cond(&TargetSys# > 1 *or &TargetSys# = 1 +
*and &Check_By *ne 'IP') Then(CpyF +
FromFile(QTEMP/FtpTimeLog) +
ToFile(QTEMP/FtpTimeErr) MbrOpt(*Add) +
FmtOpt(*NoChk))
/*time-a.nist.gov?*/
If Cond(&TargetSys# = 1) Then(Do)
ChgVar Var(&Target_Sys) Value('time-a.nist.gov')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('129.6.15.28'))
EndDo
/*time-b.nist.gov?*/
If Cond(&TargetSys# = 2) Then(Do)
ChgVar Var(&Target_Sys) Value('time-b.nist.gov')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('129.6.15.29'))
EndDo
/*time-a.timefreq.bldrdoc.com?*/
If Cond(&TargetSys# = 3) Then(Do)
ChgVar Var(&Target_Sys) +
Value('time-a.timefreq.bldrdoc.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('132.163.4.101'))
EndDo
/*time-b.timefreq.bldrdoc.com?*/
If Cond(&TargetSys# = 4) Then(Do)
ChgVar Var(&Target_Sys) +
Value('time-b.timefreq.bldrdoc.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('132.163.4.102'))
EndDo
/*time-c.timefreq.bldrdoc.com?*/
If Cond(&TargetSys# = 5) Then(Do)
ChgVar Var(&Target_Sys) +
Value('time-c.timefreq.bldrdoc.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('132.163.4.103'))
EndDo
/*utcnist.colorado.edu?*/
If Cond(&TargetSys# = 6) Then(Do)
ChgVar Var(&Target_Sys) Value('utcnist.colorado.edu')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('128.138.140.44'))
EndDo
/*time.nist.gov?*/
If Cond(&TargetSys# = 7) Then(Do)
ChgVar Var(&Target_Sys) Value('time.nist.gov')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('192.43.244.18'))
EndDo
/*time-nw.nist.gov?*/
If Cond(&TargetSys# = 8) Then(Do)
ChgVar Var(&Target_Sys) Value('time-nw.nist.gov')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('131.107.1.10'))
EndDo
/*nist1.datum.com?*/
If Cond(&TargetSys# = 9) Then(Do)
ChgVar Var(&Target_Sys) Value('nist1.datum.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('66.243.43.21'))
EndDo
/*nist1-dc.glassey.com?*/
If Cond(&TargetSys# = 10) Then(Do)
ChgVar Var(&Target_Sys) Value('nist1-dc.glassey.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('216.200.93.8'))
EndDo
/*nist1-ny.glassey.com?*/
If Cond(&TargetSys# = 11) Then(Do)
ChgVar Var(&Target_Sys) Value('nist1-ny.glassey.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('208.184.49.9'))
EndDo
/*nist1-sj.glassey.com?*/
If Cond(&TargetSys# = 12) Then(Do)
ChgVar Var(&Target_Sys) Value('nist1-sj.glassey.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('207.126.98.204'))
EndDo
/*nist1.aol-ca.truetime.com?*/
If Cond(&TargetSys# = 13) Then(Do)
ChgVar Var(&Target_Sys) +
Value('nist1.aol-ca.truetime.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('207.200.81.113'))
EndDo
/*nist1.aol-va.truetime.com?*/
If Cond(&TargetSys# = 14) Then(Do)
ChgVar Var(&Target_Sys) +
Value('nist1.aol-va.truetime.com')
If Cond(&Check_By = 'IP') Then(+
ChgVar Var(&Target_Sys) Value('205.188.185.33'))
EndDo
/*?Delete/Create the FTP transfer log file and override ?*/
DltF File(QTEMP/FtpTimeLog)
MonMsg MsgID(CPF0000)
CrtPF File(QTEMP/FtpTimeLog) RcdLen(132) +
Mbr(FtpTimeLog)
OvrDbF File(Input) ToFile(*LIBL/QTXTSRC) +
MBR(FtpTimeCmd)
OvrDbF File(Output) ToFile(QTEMP/FtpTimeLog) +
Mbr(FtpTimeLog)
/*?Execute FTP transfer and get rid of overrides. ?*/
StrTCPFTP RmtSys(&Target_Sys) Port(13)
DltOvr File(*ALL)
/*?Parse FtpTimeLog File for time string ?*/
Read_Again: RcvF
/*?End of file and record not found. Check next server?*/
MonMsg MsgID(CPF0864) Exec(GoTo CmdLbl(Set_Target))
/*?Find the line containing 'UTC(NIST)' - that's where the time is ?*/
ChgVar Var(&String) Value(&FtpTimeLog)
Call Pgm(QCLSCAN) Parm(&String &StrLen &StrPos +
&UTCNIST &UTCNISTLen '1' '1' &Wild &Result)
/*?If not found, read next record?*/
If Cond(&Result = 0) Then(GoTo CmdLbl(Read_Again))
/*?Now scan for ':' to get Time position. Convert the string to ?*/
/*?HH MM SS Values ?*/
Call Pgm(QCLSCAN) Parm(&String &StrLen &StrPos +
&Pattern &PatLen &Translate &Trim &Wild +
&Result)
/*?Time ':' not found in string = error?*/
If Cond(&Result = 0) Then(GoTo CmdLbl(Error))
/*?Calculate new Time ?*/
/*?Set UTC Time string received from Time server?*/
ChgVar Var(&Result) Value(&Result - 2)
ChgVar VAR(&HH) Value(%sst(&FtpTimeLog &Result 2))
ChgVar Var(&Result) Value(&Result + 3)
ChgVar Var(&MM) Value(%SST(&FtpTimeLog &Result 2))
ChgVar Var(&Result) Value(&Result + 3)
ChgVar Var(&SS) Value(%SST(&FtpTimeLog &Result 2))
/*?Get UTC Time offset hours and + or - sign from sysval?*/
RtvSysVal SysVal(QUTCOFFSET) RtnVar(&UTCSysVal)
ChgVar Var(&UTCSign) Value(%SST(&UTCSysVal 1 1))
ChgVar Var(&UTC) Value(%SST(&UTCSysVal 2 2))
/*?Set Daylight Savings Time, if necessary (QUTCOFFSET)?*/
/*?Eastern Standard Time = UTC -5 Hours? */
/*?Eastern Daylight Savings Time = UTC -4 Hours? */
If Cond(&DST) Then(Do)
/*?Ensure that this is a Sunday and AFTER 02:00 AM?*/
RtvSysVal SysVal(QDAYOFWEEK) RtnVar(&DayOfWeek)
RtvSysVal SysVal(QHOUR) RtnVar(&QHour)
If Cond(&DayOfWeek *eq '*SUN' *and &QHour *GE +
'02') Then(Do)
RtvSysVal SysVal(QMONTH) RtnVar(&Month)
RtvSysVal SysVal(QDAY) RtnVar(&Day)
/*?1st Sunday in April start Daylight Saving Time?*/
If Cond(&Month = '04' *and &Day *LE '07') +
Then(ChgVar Var(&UTCSysVal) Value('-0400'))
/*?Last Sunday in October end Daylight Saving Time?*/
If Cond(&Month = '10' *and &Day *GE '25') +
Then(ChgVar Var(&UTCSysVal) Value('-0500'))
EndDo /* If *SUN, after 02:00 AM */
EndDo /* DST ='1' */
/*?End Daylight Savings Time settings?*/
ChgVar Var(&HH#) Value(&HH)
If Cond(&UTCSign = '-') Then(Do)
ChgVar Var(&HH#) Value(&HH# - &UTC)
If Cond(&HH# < 0) Then(ChgVar Var(&HH#) +
Value(24 + &HH#))
EndDo
Else Cmd(Do) /* &UTCSign = '+' */
ChgVar Var(&HH#) Value(&HH# + &UTC)
If Cond(&HH# > 23) Then(ChgVar Var(&HH#) +
Value(&HH# - 24))
EndDo
ChgVar Var(&HH) Value(&HH#)
/*?Change system Value QTIME and, if necessary, QUTCOFFSET ?*/
If Cond(&Update) Then(Do)
ChgVar Var(&Time) Value(&HH || &MM || &SS)
RtvSysVal SysVal(QTIME) RtnVar(&QTIME)
ChgSysVal SysVal(QTIME) Value(&TIME)
If Cond(&DST) Then(ChgSysVal SysVal(QUTCOFFSET) +
Value(&UTCSysVal))
/*?Set up the good compleation message?*/
ChgVar Var(&MsgDta) Value(&PgmLib *tcat '/' *cat +
&PgmName *bcat 'has changed system time +
from' *bcat %sst(&QTime 1 2) +
*cat ':' *cat %sst(&QTime 3 2) *cat ':' +
*cat %sst(&QTime 5 2) *bcat 'to' +
*bcat &HH *cat ':' *cat &MM *cat +
':' *cat &SS)
/*?If Daylight Savings time, set swith to On/Off?*/
If Cond(&DST) Then(Do)
If Cond(&UTCSysVal = '-0500') Then(ChgVar +
Var(&MsgDta) Value(&MsgDta *bcat '- +
Daylight Savings Time is Off.'))
If Cond(&UTCSysVal = '-0400') Then(ChgVar +
Var(&MsgDta) Value(&MsgDta *bcat '- +
Daylight Savings Time is ON!'))
EndDo
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) MsgDta(&MsgDta) +
ToUsr(*SYSOPR) MsgType(*INFO)
EndDo /* If Update */
Return /* Good completion */
/*?On error send mesage ?*/
Error:
OvrPrtF File(QSYSPRT) SplFName(Ftp_Time)
If Cond(&TargetSys# = 1 *and Check_By = 'IP') +
Then(CpyF FromFile(QTEMP/FtpTimeLog) +
ToFile(*PRINT) FmtOpt(*NoChk))
If Cond(Check_By *ne 'IP') Then(CpyF +
FromFile(QTEMP/FtpTimeErr) ToFile(*PRINT) +
FmtOpt(*Nochk))
DltOvr File(QSYSPRT)
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) MsgDta(&PgmLib +
*tcat '/' *cat &PgmName *bcat 'ended in +
ERROR! Check joblog for details, or +
review the FTP_TIME spool file.') +
ToUsr(*SYSOPR) MsgType(*ESCAPE)
ThaEnd: EndPgm
[report a broken link by clicking here]