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]