*===================================================================== * RPG ILE MODULE MMAIL/YYYDETACH for service program MMAIL/SOCKETMAIL * * Subprocedure AMMDetach * - Detachs attachments from an e-mail message stream file * - Individual attachments are generated as separate IFS files, CCSID 819 * *===================================================================== Hnomain /copy *LIBL/qrpglesrc,hspecs * AMailer users FAMUSERS if e k disk usropn * Index of mail messages FAMMAIL uf e k disk usropn * Attachments FAMATTACHS uf a e k disk usropn * Attachments with extension .ZIP FAMATTZIP uf a e k disk usropn /copy *LIBL/qrpglesrc,prototypeb /copy *LIBL/qrpglesrc,mailproto /copy *LIBL/qrpglesrc,yyyproto /copy *LIBL/qrpglesrc,usec /copy *LIBL/qrpglesrc,variables3 *===================================================================== * "AMMDetach" subprocedure * Purpose: Detachs attachments from an e-mail message stream file * Input: Identifier of account (30) * Input: Identifier of the e-mail message stream file (30) * Output: None * Example: * D xamoowner s 30 * D xammid s 30 * C callp AMMDetach(xamoowner:xammid) * *================ * "AMMDetach" subprocedure definition P AMMDetach b export D AMMDetach pi D xamoowner like(amoowner) D xammid 30 * D MsgFile s 256 D AtchDir s 256 D AtchFile s 256 D AtchTempFile s 256 D Obj s 1024 * Variables for CHKIFS D IfsFileNam s 1024 D IfsFileSiz s 10i 0 D IfsCrtStamp s z * Variables to handle attachments D PartStr s 10i 0 Start of a part D PartEnd s 10i 0 End of a part D PartType s 100 Content-Type D PartDisp s 100 Content-Disposition D PartDesc s 100 Content-Description D PartTran s 100 Content-Transfer-Enc D PartCID s 100 Content-ID * D atchstr s 10i 0 dim(100) D atchend s 10i 0 dim(100) D atchType s 100 dim(100) Content-Type D atchDisp s 100 dim(100) Content-Disposition D atchDesc s 100 dim(100) Content-Description D atchTran s 100 dim(100) Content-Transfer-Enc D atchCID s 100 dim(100) Content-ID * D atchnbr s 10i 0 D i s 10i 0 D atchFName s like(amaoname) D BadPropsInd s n D Cmd s 1000 *================================= * Pointers D MyPropPntr s * inz(%addr(Properties)) pointer->Properties * Variable pointers D VarP s * variable pointer D VarP1 s * variable pointer D VarPEnd s * * Properties string for the message stream file D ds D Properties 1 32767 properties string D TotEntryLen 1 4b 0 properties length * Header entry D HDREntry ds based(varP) D HDREntryLen 10i 0 D HDREntryType 2 D HDREntryWord 50 D HDREntryDta 500 varying * Part entry D PRTEntry ds based(varP) D PRTEntryLen 10i 0 D PRTEntryType 2 D PRTEntryStr 10i 0 D PRTEntryEnd 10i 0 D*PRTHeader s 100 varying based(varP1) D PRTHeader s 1000 varying based(varP1) *================================= * Variables to read the MIME stream file D MaxAlloc s 10u 0 inz(16773104) D ReadBufSize s 10u 0 D ReadBufPntr s * D ReadBufPntr1 s * D varPntr s * D varPntr1 s * D FileHandle1 s 10i 0 D BytesIn s 10i 0 D TotBytesIn s 10i 0 D TotBytesIn1 s 10i 0 D TotBytesRead s 10i 0 D LastEnd s 10i 0 D ReadLen s 10i 0 D ReadDtaL s 10i 0 D DataIn s 30000 based(ReadBufPntr) D DataIn1 s 30000 D DataInArr s 1 dim(30000) D DataInArr1 s 1 dim(30000) D InpDtaChar ds based(varPntr) D InpdtaChar1 1 1 D InpdtaChar2 2 2 D OutDtaChar s 1 based(varPntr1) D Last4Chars s 4 based(Last4CharsP) D Last4CharsP s * D TrimLastLen s 10i 0 D a s 10i 0 D a1 s 10i 0 D a2 s 10i 0 D a3 s 10i 0 D x s 10i 0 D y s 10i 0 D inLen s 10i 0 D l s 10i 0 D totl s 10i 0 D r s 10i 0 D r1 s 10i 0 D r2 s 10i 0 D size s 15s 3 D EOR s 2 inz(x'0d25') D EOROffInd s n D nbrEOROff s 10i 0 * Variables to write the attachment stream file D amanbrc s 5 D AsciiCCSID s 10s 0 inz(819) D FileHandle2 s 10i 0 D TempHandle2 s 10i 0 D BytesOut s 10i 0 D DataOut s 30000 D outLen s 10i 0 D TotBytesOut s 10i 0 * For SndPgmMsg D module s 10a inz('YYYDETACH') D topgmq s 5a inz('*EXT') D msgtype s 7a inz('*INFO') D msg s 512a * D amzonameUP s like(amzoname) D totatc s 10i 0 D totamz s 10i 0 *===================================================================== * Main line *===================================================================== C eval totatc=0 total attachments C eval totamz=0 total .ZIP files * Open files C exsr OpnF * Message stream file C eval MsgFile='/amailer/' + C %trim(amombr) + '/' + C %trim(xammid) * Get Message file properties C eval Properties=' ' C callp getMsgProp(MsgFile:MyPropPntr) C if Properties=' ' C eval msg='Could not get properties of stream + C file ' + C %trim(MsgFile) C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif * Get attachment extents into arrays "atchstr", "atchend", etc. C exsr GetAtchExt * Copy the attachments to individual stream files * - Open the MIME file C eval FileHandle1 = open(%trim(MsgFile) C :O_RDONLY + O_TEXTDATA) C if FileHandle1<0 C eval msg='Could not open stream file ' + C %trim(MsgFile) C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif * - Copy the attachments C if atchnbr>0 C eval totBytesRead=0 C eval totBytesIn=0 C 1 do atchnbr i C exsr ExtrAtch C enddo C endif * - Close the MIME file C eval rc=close(FileHandle1) * Unzip all .ZIP attachments C exsr Unzip * Flag the mail record as Ready C xammid chain ammrcd C if %found C eval AMMREAD='R' Ready, not yet read C update ammrcd C endif * C exsr Exit *===================================================================== * Get attachment extents into arrays "atchstr", "atchend", etc. *===================================================================== C GetAtchExt begsr C eval BadPropsInd=*off * Clear C 1 do 100 i C eval atchstr(i) =0 C eval atchend(i) =0 C eval atchType(i)=' ' C eval atchDisp(i)=' ' C eval atchDesc(i)=' ' C eval atchTran(i)=' ' C eval atchCID(i)=' ' C enddo C eval atchnbr=0 * Loop across all properties entries C eval i=0 C eval varP=MyPropPntr +4 C eval varPEnd=MyPropPntr +TotEntryLen C DOW varP'01' and C HDREntryType<>'02' C leave C endif C IF HDREntryType='02' C eval PartStr =PRTEntryStr C eval PartEnd =PRTEntryEnd C eval VarP1=VarP+14 C eval PartType=PRTHeader C eval VarP1=VarP1+%len(PRTHeader)+2 C eval PartDisp=PRTHeader C eval VarP1=VarP1+%len(PRTHeader)+2 C eval PartDesc=PRTHeader C eval VarP1=VarP1+%len(PRTHeader)+2 C eval PartTran=PRTHeader C eval VarP1=VarP1+%len(PRTHeader)+2 C if VarP1'ATTACHMENT' C eval %subst(PartDisp:1:10)='ATTACHMENT' C endif C if %subst(PartDisp:1:10)='ATTACHMENT' C eval atchnbr=atchnbr+1 C eval i=i+1 C eval atchstr(i) =PartStr C eval atchend(i) =PartEnd C eval atchType(i)=PartType C eval atchDisp(i)=PartDisp C eval atchDesc(i)=PartDesc C eval atchTran(i)=PartTran C eval atchCID(i)=PartCID C endif C ENDIF * - set pointer to the next entry * - if not possible, raise BadPropsInd C if PRTEntryLen>0 C eval varP=varP + PRTEntryLen C else C eval BadPropsInd=*on C leave exit DOW C endif C ENDDO * C endsr *===================================================================== * Extract a single attachment to an individual stream file *===================================================================== C ExtrAtch begsr C eval TotBytesOut=0 C eval PartStr =atchstr(i) C eval PartEnd =atchend(i) C eval PartType=atchType(i) C eval PartDisp=atchDisp(i) C eval PartDesc=atchDesc(i) C eval PartTran=atchTran(i) C eval PartCID =atchCID(i) * Create the directory to contain the attachment file C eval amanbr=i C move amanbr amanbrc C eval AtchDir='/amailer/' + C %trim(amombr) + C '/Attachments/' + C %trim(xammid) + '_' + C %trim(amanbrc) C eval rc=docmd('md ''' + C %trim(AtchDir) + C ''' dtaaut(*exclude) objaut(*none)') C eval Obj=AtchDir C exsr ChgAut * Retrieve the original file name ("atchFname") C exsr RtvAtcName C eval atchFName=uppify(atchFName) * If the original file name ("atchFname") is blank, and Content-ID provided, ... C if atchFName=' ' and PartCID<>'*NULL' and C PartCID<>' ' C eval atchFName=%trim(PartCID) C endif * If the original file name ("atchFname") still blank, name it as the message file C if atchFName=' ' C eval atchFName=xammid C endif * Replace imbedded blanks with _'s C eval r1=%len(%trimr(atchFName)) C eval atchFName=%xlate(' ':'_':atchFName) C eval atchFName=%subst(atchFName:1:r1) * Make up * - the name ("atchFile") of the attachment stream file C eval AtchFile=%trim(Atchdir)+ '/' + C %trim(atchFName) * - the name ("atchTempFile") to be used for * . BASE64 decode * . QUOTED-PRINTABLE decode C IF PartTran='BASE64' or C PartTran='QUOTED-PRINTABLE' C eval AtchTempFile=%trim(Atchdir)+ '/temp_' + C %trim(atchFName) C ENDIF * Create the attachment stream file C eval rc =docmd('del ''' + C %trim(atchFile) + '''') C eval FileHandle2=open(%trim(AtchFile) C : O_CREAT + O_WRONLY + O_TRUNC + C O_CCSID C : S_IRWXU + S_IROTH C : AsciiCCSID) C if FileHandle2<0 C eval msg='Could not create stream file ' + C %trim(AtchFile) C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif C eval rc = close(FileHandle2) C eval Obj=AtchFile C exsr ChgAut * Create the temporary attachment stream file to be used for Base64/quoted-printable decode C IF PartTran='BASE64' or C PartTran='QUOTED-PRINTABLE' C eval rc =docmd('del ''' + C %trim(atchTempFile) + '''') C eval TempHandle2=open(%trim(AtchTempFile) C : O_CREAT + O_WRONLY + O_TRUNC + C O_CCSID C : S_IRWXU + S_IROTH C : AsciiCCSID) C if TempHandle2<0 C eval msg='Could not create stream file ' + C %trim(AtchTempFile) C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif C eval rc = close(TempHandle2) C ENDIF C eval Obj=AtchTempFile C exsr ChgAut * Position input to the start of the extent C exsr PosToStart * Copy the attachment from the input stream file to the output stream file C exsr CopyAtch * Compute the attachment size in K C eval IfsFileNam=AtchFile C eval rc = ChkIfs(IfsFileNam:IfsFileSiz: C IfsCrtStamp) C eval size=IfsFileSiz C eval size=size/1024 C eval size=size+.5 C if size<1 C eval size=1 C endif * Add an attachment record C amakey klist C kfld amaid C kfld amanbr C eval amaid=xammid C eval amanbr=i C amakey chain amarcd C eval amaoname=atchFName original file name C eval amasize =size size in K C eval amatrans=PartTran Content-Transfer-Enc C if %found(amattachs) C update amarcd C else C write amarcd C endif C eval totatc=totatc+1 total attachments * If a .ZIP attachment * - write a record to file QTEMP/AMATTZIP * - score total number of .ZIP files into count field "totamz" C amzkey klist C kfld amzid C kfld amznbr C eval amzoname=amaoname original file name C eval amzonameUP=uppify(amzoname) original file name C eval l=%len(%trim(amzonameUP)) C eval r=%scan('.ZIP':amzonameUP) C IF r>0 and r=l-3 C eval amzid =amaid C eval amznbr=amanbr C amzkey chain amzrcd C if %found C update amzrcd C else C write amzrcd C endif C eval totamz=totamz+1 C ENDIF * C endsr *===================================================================== * Retrieve the attachment file name ("atchName") * Examples: * 1- Content-type: IMAGE/GIF; NAME="VS_LOGO_3.GIF" * 2- Content-disposition: ATTACHMENT; FILENAME="VS_LOGO_3.GIF" * 3- Content-description: "VS_LOGO_3.GIF" *===================================================================== /free Begsr RtvAtcName; atchFName=' '; a1=0; a2=0; a3=0; a1=%scan('NAME=':PartType); //Check Content-type if a1>0; exsr RtvAtcNam1; else; a2=%scan('FILENAME=':PartDisp); //Check Content-disposition if a2>0; exsr RtvAtcNam2; else; if PartDesc<>'*NULL' and PartDesc<>' '; a3=1; endif; if a3>0; exsr RtvAtcNam3; //Check Content-description endif; endif; endif; Endsr; /end-free *===================================================================== * Retrieve the attachment file name ("atchFName") * Case: * 1- Content-type: IMAGE/GIF; NAME="VS_LOGO_3.GIF" *===================================================================== C RtvAtcNam1 begsr C eval a1=%scan('NAME=':PartType) C IF a1>0 C eval atchFName=%subst(PartType:a1+5) C eval atchFName=%xlate('"':' ':atchFName) C eval atchFName=%xlate(';':' ':atchFName) C eval atchFName=%trim(atchFName) C ENDIF * C endsr *===================================================================== * Retrieve the attachment file name ("atchFName") * Case: * 2- Content-disposition: ATTACHMENT; FILENAME="VS_LOGO_3.GIF" *===================================================================== C RtvAtcNam2 begsr C eval a1=%scan('FILENAME=':PartDisp) C IF a1>0 C eval atchFName=%subst(PartDisp:a1+9) C eval atchFName=%xlate('"':' ':atchFName) C eval atchFName=%xlate(';':' ':atchFName) C eval atchFName=%trim(atchFName) C ENDIF * C endsr *===================================================================== * Retrieve the attachment file name ("atchFName") * Case: * 3- Content-description: "VS_LOGO_3.GIF" *===================================================================== C RtvAtcNam3 begsr C eval atchFName=PartDesc C eval atchFName=%xlate('"':' ':atchFName) C eval atchFName=%xlate(';':' ':atchFName) C eval atchFName=%trim(atchFName) * C endsr *===================================================================== * Position input to the start of the extent *===================================================================== C PosToStart begsr C eval readLen=PartStr-1-totBytesRead * Allocate buffer C if ReadLen>MaxAlloc C eval ReadBufSize=MaxAlloc C else C eval ReadBufSize=readLen C endif C alloc ReadBufSize ReadBufPntr * C eval totBytesIn=0 C DOW totBytesIn'BASE64' and C PartTran<>'QUOTED-PRINTABLE' C eval FileHandle2 = open(%trim(AtchFile) C : O_TEXTDATA + O_RDWR + O_APPEND) C ELSE C eval FileHandle2 = open(%trim(AtchTempFile) C : O_TEXTDATA + O_RDWR + O_APPEND) C ENDIF C if FileHandle2<0 C eval msg='Could not open stream file ' + C %trim(AtchTempFile) C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif * Whether CarriageReturn-LineFeed control chars should be removed from the attachment C eval EORoffInd=*off C if PartTran='BASE64' C eval EORoffInd=*on C endif * C eval nbrEOROff=0 C eval readLen=PartEnd-PartStr * Allocate read buffer C if ReadLen>MaxAlloc C eval ReadBufSize=MaxAlloc C else C eval ReadBufSize=readLen C endif C alloc ReadBufSize ReadBufPntr *================== C eval totBytesIn=0 C DOW totBytesIn=readLen C eval Last4CharsP=ReadBufPntr+TotBytesIn1-4 C if Last4Chars=EOR+EOR C eval TrimLastLen=2 C endif C endIf C ENDIF C IF EORoffInd=*off C eval BytesOut= write(FileHandle2 C : ReadBufPntr C : BytesIn-TrimLastLen) C ELSE C exsr TakeEOROff purge crlf's C eval BytesOut= write(FileHandle2 C : ReadBufPntr1 C : inLen) C dealloc ReadBufPntr1 C ENDIF EORoffInd ? C eval totBytesIn =totBytesIn + BytesIn C eval totBytesRead=totBytesRead + BytesIn C eval totBytesOut=totBytesOut + BytesOut C ENDDO *================== * Close output stream file C eval rc = close(FileHandle2) * If BASE64, * decode the base64 temporary attachment file into the final attachment file C IF PartTran='BASE64' C eval Cmd='mmail/am64decode infile(''' + C %trim(AtchTempFile) + C ''') outfile(''' + C %trim(AtchFile) + ''')' C eval rc=docmd(Cmd) C eval Obj=AtchFile C exsr ChgAut * delete the base64 temporary attachment file C eval rc=docmd('del ''' + C %trim(AtchTempFile) + '''') C ENDIF * If QUOTED-PRINTABLE, * decode the quoted-printable temporary attachment file into the final attachment file C IF PartTran='QUOTED-PRINTABLE' C eval Cmd='mmail/amqpdecode infile(''' + C %trim(AtchTempFile) + C ''') outfile(''' + C %trim(AtchFile) + ''')' C eval rc=docmd(Cmd) C eval Obj=AtchFile C exsr ChgAut * delete the quoted-printable temporary attachment file C eval rc=docmd('del ''' + C %trim(AtchTempFile) + '''') C ENDIF * C endsr *===================================================================== * Copy from one buffer to another buffer, final length in inLen *===================================================================== C TakeEOROff begsr * Allocate output buffer C alloc ReadBufSize ReadBufPntr1 * C eval varPntr = ReadBufPntr C eval varPntr1= ReadBufPntr1 C eval x=0 C eval y=0 C DOW x0 C leavesr C endif * C xammid setll amzrcd C xammid reade amzrcd C DOW not %eof C callb 'YYYUNZIP' tne UNZIPper C parm totatc C parm amombr C parm amzid C parm amznbr C parm amzoname C xammid reade amzrcd C ENDDO * C endsr *===================================================================== * Change object authorities *===================================================================== C ChgAut begsr /free rc=docmd('chgaut obj(''' + %trim(Obj) + ''') + user(' + %trim(psdsUsrNam) + ') + dtaaut(*rwx) objaut(*all)'); rc=docmd('chgaut obj(''' + %trim(Obj) + ''') + user(QTMHHTP1) + dtaaut(*rwx) objaut(*all)'); rc=docmd('chgaut obj(''' + %trim(Obj) + ''') + user(QTMHHTTP) + dtaaut(*rx)'); rc=docmd('chgaut obj(''' + %trim(Obj) + ''') + user(*PUBLIC) + dtaaut(*exclude) objaut(*none)'); rc=docmd('chgown obj(''' + %trim(Obj) + ''') + newown(' + %trim(psdsUsrPrf) + ') rvkoldaut(*no)'); /end-free C endsr *===================================================================== * Open files *===================================================================== C OpnF begsr C exsr CloF *------------------ * Open file MMAILDATA/AMUSERS C if not %open(AMUSERS) C eval rc=docmd('ovrdbf AMUSERS + C MMAILDATA/AMUSERS ovrscope(*job) + C secure(*yes)') C open AMUSERS C endif *------------------ * Retrieve member name C eval amoowner=xamoowner C amoowner chain amorcd C if not %found C eval msg='Could not retrieve record "' + C %trim(amoowner) + C '" from file MMAILDATA/AMUSERS' C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endif *------------------ * Open file MMAILDATA/AMMAIL (Mail records) C if not %open(AMMAIL) C eval rc=docmd('ovrdbf AMMAIL + C MMAILDATA/AMMAIL ovrscope(*job) + C mbr(' + %trim(amombr) + ') + C secure(*yes)') C open AMMAIL C endif *------------------ * Open file MMAILDATA/AMATTACHS (Attachments) C if not %open(AMATTACHS) C eval rc=docmd('ovrdbf AMATTACHS + C MMAILDATA/AMATTACHS ovrscope(*job) + C mbr(' + %trim(amombr) + ') + C secure(*yes)') C open AMATTACHS C endif *------------------ * Duplicate file AMATTZIP (.ZIP attached files) to library QTEMP, clear and open it C eval rc=docmd('chkobj qtemp/AMATTZIP *file') C if rc<>0 C eval rc=docmd('crtdupobj AMATTZIP mmail + C *file qtemp') C endif C eval rc=docmd('clrpfm qtemp/AMATTZIP') C if not %open(AMATTZIP) C eval rc=docmd('ovrdbf AMATTZIP + C QTEMP/AMATTZIP ovrscope(*job) + C secure(*yes)') C open AMATTZIP C endif * C endsr *===================================================================== * Close files *===================================================================== C CloF begsr * C if %open(AMUSERS) C close AMUSERS C eval rc=docmd('dltovr AMUSERS lvl(*job)') C endif * C if %open(AMMAIL) C close AMMAIL C eval rc=docmd('dltovr AMMAIL lvl(*job)') C endif * C if %open(AMATTACHS) C close AMATTACHS C eval rc=docmd('dltovr AMATTACHS lvl(*job)') C endif * C if %open(AMATTZIP) C close AMATTZIP C eval rc=docmd('dltovr AMATTZIP lvl(*job)') C endif * C endsr *===================================================================== * Back to caller *===================================================================== C Exit begsr C exsr CloF C return C endsr *===================================================================== * Program status subroutine *===================================================================== C *pssr begsr C callp wrtpsds(psds) C eval msg='Entered *PSSR, dsppfm MMAIL/CGIDEBUG' C callp SndPgmMsg(module:topgmq:msgtype:msg) C exsr Exit C endsr *===================================================================== P AMMDetach e