|
midrange.com
And just in case "anyone else was trying to do something similar" I'll just
give a bit of warning that the offset being off by two bytes is considered
an error and will be corrected in the future so you may want to keep track
of where you add 2 to the offset value if adopting this workaround.
Bruce Vining
Sean Porterfield
<sporter@bestdist
.com> To
Sent by: RPG programming on the AS400 /
rpg400-l-bounces@ iSeries <rpg400-l@xxxxxxxxxxxx>
midrange.com cc
Subject
04/22/2005 01:12 QsyParseCertificate working
PM
Please respond to
RPG programming
on the AS400 /
iSeries
I posted about parsing certificates from the telnet server quite a while
back and hadn't
gotten it working. I found out from IBM that the offset to the certificate
was off by
two (though they didn't officially call it a bug.) The program below may
still have some
leftover bits unrelated to the problem and may not be the "best" way to do
some things,
but it does retrieve the CN (username) from the certificate. I thought I'd
post it in
case anyone else was trying to do something similar.
Apply standard disclaimers here.
/* Log connections, verify certificate on SSL connections
*/
/* Thanks to Scott Klement for some of the code that he posted on
MIDRANGE-L */
/* http://archive.midrange.com/midrange-l/200103/msg00068.html
*/
H DFTACTGRP(*NO) ACTGRP('TELNET') BNDDIR('QC2LE')
D inet_ntoa PR * ExtProc('inet_ntoa')
D ulong_addr 10U 0 VALUE
D Cmd PR ExtPgm('QCMDEXC')
D Command 500A const options(*varsize)
D Length 15P 5 const
D ParseCert PR ExtProc('QsyParseCertificate')
D Certificate * value
D CertType 10I 0 value
D CertLen 10I 0 value
D CertFmt 8 const
D CertRcvr * value
D CertRcvrLen 10I 0 value
D CertErr * value
D peUserDscInfo S 1A
D peDevDscInfo S 1A
D peCnnDscInfo S 1A
D peEnvOpt S 1A
D peEnvOptLen S 10I 0
D peAllowConn S 1A
D peAutoSignOn S 1A
D p_Cert S * inz(*NULL)
D CertType S 10I 0 inz(1)
D ParseFmt S 8 inz('CERT0200')
D CrtUser S 10A
D Msg S 500A varying
D p_UserDscInfo S * inz(*NULL)
D dsUserDscInfo DS based(p_UserDscInfo)
D dsUserLen 10I 0
D dsUserProfile 10A
D dsUserCurLib 10A
D dsUserProgram 10A
D dsUserMenu 10A
D p_DevDscInfo S * inz(*NULL)
D dsDevDscInfo DS based(p_DevDscInfo)
D dsDevName 10A
D dsDevFormat 8A
D dsDevReserved 2A
D dsDevAttrOff 10I 0
D dsDevAttrLen 10I 0
D p_CnnDscInfo S * inz(*NULL)
D dsCnnDscInfo DS based(p_CnnDscInfo)
D dsCnnLen 10I 0
D dsCnnAddr 20A
Client IP address
D dsCnnPWvalid 1A
D dsCnnWStype 12A
D dsCnnRsv1 2A
Part of WStype?
D dsCnnSSL 1A
D dsCnnSvrAddr 20A
Server IP address
D dsCnnClAut 1A
Client Auth Level
D dsCnnRsv2 3A
D dsCnnCertVld 10I 0
Return Code
D dsCnnCertOff 10I 0
Offset to Cert
D dsCnnCertLen 10I 0
Certificate Length
D p_Addr S * inz(*NULL)
D dsAddr DS based(p_Addr)
D dsAddrLen 3I 0
D dsAddrFamily 3I 0
D dsAddrPort 5U 0
D dsAddrIP 10U 0
D dsCert DS 32767
D dsCertLen 1 4I 0
D dsCertAvail 5 8I 0
D dsCertCNOff 105 108I 0
Common Name (user)
D dsCertCNLen 109 112I 0
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
c *entry plist
c parm peUserDscInfo
c parm peDevDscInfo
c parm peCnnDscInfo
c parm peEnvOpt
c parm peEnvOptLen
c parm peAllowConn
c parm peAutoSignOn
c eval p_UserDscInfo = %addr(peUserDscInfo)
c eval p_DevDscInfo = %addr(peDevDscInfo)
c eval p_CnnDscInfo = %addr(peCnnDscInfo)
c if dsCnnSSL = '1'
* validate certificate
c dsCnnCertLen ifne *ZERO
c eval p_Cert = p_CnnDscInfo + dsCnnCertOff +
2
c callp ParseCert(p_Cert : CertType :
dsCnnCertLen
c : ParseFmt : %addr(dsCert)
c : %len(dsCert) : %addr(dsEC))
c dsECBytesA ifne *ZERO
* an error has occurred
c else
c dsCertCNOff ifeq *ZERO
* no CN?
c else
c eval CrtUser = %subst(dsCert :
c dsCertCNOff + 1 : dsCertCNLen)
c dsply CrtUser
c endif
dsCertCNOff=0
c endif
dsECBytesA<>0
c endif
dsCnnCertLen<>0
c endif
dsCnnSSL='1'
c return
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
