CMD PROMPT('Send Syslog Message') PARM KWD(RMTSYS) TYPE(*CHAR) LEN(128) MIN(1) + PROMPT('Remote System') PARM KWD(FACILITY) TYPE(*DEC) LEN(2) RANGE(0 23) + MIN(1) PROMPT('Facility') PARM KWD(Severity) TYPE(*DEC) LEN(2) RANGE(0 7) + MIN(1) PROMPT('Severity') PARM KWD(MSG) TYPE(*CHAR) LEN(1000) MIN(1) + PROMPT('Message to Send') ---- H DFTACTGRP(*NO) ACTGRP(*NEW) H BNDDIR('QC2LE') D/copy qrpglesrc,socket_h D/copy qrpglesrc,sockutil_h D/copy qrpglesrc,errno_h D translate PR ExtPgm('QDCXLATE') D length 5P 0 const D data 32766A options(*varsize) D table 10A const D gethostname PR extproc('gethostname') D localname * value D localnamelen 10I 0 value D die PR D peMsg 256A const D sock S 10I 0 D err S 10I 0 D len S 10I 0 D bindto S * D addr S 10U 0 D buf S 1000A D buflen S 10I 0 D host S 128A D localhost S 128A D priority S 10I 0 D facility S 2P 0 D severity S 2P 0 D msg S 1000A D destlen S 10I 0 D destaddr S * D months S 3A dim(12) ctdata perrcd(12) c *entry plist c parm host c parm facility c parm severity c parm msg c eval *inlr = *on C* Get the 32-bit network IP address for the host c eval addr = inet_addr(%trim(host)) c if addr = INADDR_NONE c eval p_hostent = gethostbyname(%trim(host)) c if p_hostent = *NULL c callp die('Unable to find that host!') c return c endif c eval addr = h_addr c endif C* Create a UDP socket: c eval sock = socket(AF_INET: SOCK_DGRAM: c IPPROTO_IP) c if sock < 0 c callp die('socket(): '+%str(strerror(errno))) c return c endif C* Create a socket address struct with destination info C eval destlen = %size(sockaddr_in) c alloc destlen destaddr c eval p_sockaddr = destaddr c eval sin_family = AF_INET c eval sin_addr = addr c eval sin_port = 514 c eval sin_zero = *ALLx'00' C* Calc Priority, and start to load message c eval priority = (facility*8)+severity c eval buf = '<' + %char(priority) + '>' c* load date/time in syslog format c eval buf = %trimr(buf) c + months(%subdt(%date():*M)) c + ' ' c + %char(%subdt(%date():*D)) c + ' ' c + %char(%time():*hms:) C* load system name c callp gethostname(%addr(localhost) c : %size(localhost)) c eval buf = %trimr(buf) c + ' ' c + %str(%addr(localhost)) c* load message c eval buf = %trimr(buf) c + ' ' c + msg c eval buflen = %len(%trimr(buf)) C* Convert to ASCII c callp translate(buflen: buf: 'QTCPASC') C* Send the datagram c if sendto(sock: %addr(buf): buflen: 0: c destaddr: destlen) < 0 c eval err = errno c callp close(sock) c callp die('sendto(): '+%str(strerror(err))) c return c endif C* end c callp close(sock) c return *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * This ends this program abnormally, and sends back an escape. * message explaining the failure. *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P die B D die PI D peMsg 256A const D SndPgmMsg PR ExtPgm('QMHSNDPM') D MessageID 7A Const D QualMsgF 20A Const D MsgData 256A Const D MsgDtaLen 10I 0 Const D MsgType 10A Const D CallStkEnt 10A Const D CallStkCnt 10I 0 Const D MessageKey 4A D ErrorCode 32766A options(*varsize) D dsEC DS D dsECBytesP 1 4I 0 INZ(256) D dsECBytesA 5 8I 0 INZ(0) D dsECMsgID 9 15 D dsECReserv 16 16 D dsECMsgDta 17 256 D wwMsgLen S 10I 0 D wwTheKey S 4A c eval wwMsgLen = %len(%trimr(peMsg)) c if wwMsgLen<1 c return c endif c callp SndPgmMsg('CPF9897': 'QCPFMSG *LIBL': c peMsg: wwMsgLen: '*ESCAPE': c '*PGMBDY': 1: wwTheKey: dsEC) c return P E /define ERRNO_LOAD_PROCEDURE /copy qrpglesrc,errno_h **CTDATA months JanFebMarAprMayJunJulAugSepOctNovDec