| [613] | 1 | XMS0BLOB ;(WASH ISC)/CAP-Send BLOBs (other body parts) ;04/18/2002 07:52
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine sends BLOBS (Basic Large Objects), also known in the
|
|---|
| 5 | ;messaging world as 'Other Body Parts' of messages.
|
|---|
| 6 | ;It can do this only with MailMan systems after (not including)
|
|---|
| 7 | ;version 7.0.
|
|---|
| 8 | ;
|
|---|
| 9 | ;A second portion of this code will be able to send to TCP/IP-SMTP
|
|---|
| 10 | ;systems that conform to MIME (MEE-MEE), an extension of RFC-822 that
|
|---|
| 11 | ;MailMan will conform to when dealing with MIME compatible structures.
|
|---|
| 12 | ;
|
|---|
| 13 | ;See XMR0BLOB for documentation on MPDUs (Message Protocol Data Units)
|
|---|
| 14 | ;exchanged between sender and receiver.
|
|---|
| 15 | ;
|
|---|
| 16 | ;Get data on BLOB from Imaging files
|
|---|
| 17 | S XMSBLOBX=0
|
|---|
| 18 | 0 S XMSBLOBX=$O(^XMB(3.9,XMZ,2005,XMSBLOBX)) G Q:XMSBLOBX="" S Y=$G(^(XMSBLOBX,0)) G 0:Y=""
|
|---|
| 19 | S X=+Y,ER=0,Y=$G(^MAG(2005,X,0)) G 0:Y=""
|
|---|
| 20 | S XMSBLOBT=Y,XMSBLOBT("#")=X,XMSBLOBT("NAME")=$P(Y,U),XMSBLOBT("FILE")=$P(Y,U,2),XMSBLOBT("DATE")=$P(Y,U,9)
|
|---|
| 21 | S Y(0)="" F %=3,4,5 S X=$P(Y,U,%) I X S Y(0)=$G(^MAG(2005.2,X,0)) Q:$L(Y(0))
|
|---|
| 22 | G 0:'$L(Y(0)) ;BLOB can not be sent -- no known disk reference
|
|---|
| 23 | S XMSBLOBT("DISK")=$P(Y(0),U,2),DIC=2005.02,DIC(0)="NZ"
|
|---|
| 24 | S X=$P(XMSBLOBT,U,6) D ^DIC G 0:Y<1 S XMSBLOBT("TYPE")=$P(Y,U,2)
|
|---|
| 25 | ;
|
|---|
| 26 | ;Send MPDU (Message Protocol Data Unit), Directory to send to returned
|
|---|
| 27 | ;
|
|---|
| 28 | S XMSG="MESS BLOB: "_XMSBLOBT("FILE")_"^"_XMSBLOBT("NAME")_"^"_XMSBLOBT("TYPE")_"^"_XMSBLOBT("DATE")
|
|---|
| 29 | 1 X XMSEN Q:ER X XMREC Q:ER I +XMRG'=250 G 0:$E(XMRG)=4 K ^XMB(3.9,XMZ,1,"AQUEUE",XMINST) N XMA0 S XMA0=XMCI_U_XMINST_U_XMZ D ERRR S XMINST=$P(XMA0,U,2),XMBLOBER=1,XMCI=$P(XMA0,U),XMZ=$P(XMA0,U,3) Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;Determine IP address to send BLOB to / Use domain file data if it exists
|
|---|
| 32 | S %=$P(XMRG,U,2),X=$P($G(^DIC(4.2,XMINST,"IP")),U),%=$S($L(X):X,$L(%):%,1:"")
|
|---|
| 33 | I %="" S XMSG="MESS BLOB: < BLOB(s) not sent - No FTP channel defined !!! >" X XMSEN G ERR
|
|---|
| 34 | S XMSBLOBT("IP")=%
|
|---|
| 35 | ;
|
|---|
| 36 | ;FTP file to remote site
|
|---|
| 37 | ;
|
|---|
| 38 | K XMSFTP S XMSFTP(1)=$P($G(^XMB(1,1,"FTP-GET")),U),XMSFTP(2)=$P(XMRG,U,5),XMSFTP(2,"F")=XMSBLOBT("FILE"),XMSFTP(3)=XMSBLOBT("IP"),XMSFTP("IMAGE-PTR")=XMSBLOBT("#")
|
|---|
| 39 | F I=6,7,8 S XMSFTP(I)=$P(XMRG,U,I)
|
|---|
| 40 | I '$L($G(XMSFTP(6))) S %=$G(^DIC(4.2,XMINST,3)) I $L(%) S XMSFTP(7)=$P(%,";"),XMSFTP(7.1)=$P(%,";",2)
|
|---|
| 41 | D ^XMSFTP K XMSFTP
|
|---|
| 42 | G 0
|
|---|
| 43 | ;
|
|---|
| 44 | ;Record error, set error flag to RESET message transmission,
|
|---|
| 45 | ;remove message from queue, send message to sender.
|
|---|
| 46 | ERRR N ER,XMA0
|
|---|
| 47 | ERR ;
|
|---|
| 48 | N I,XMTEXT,XMSEN,XMREC,XMRECIP,XMSITE,XMSUBJ,XMIEN,XMTO,XMINSTR
|
|---|
| 49 | S XMINSTR("FROM")=.5
|
|---|
| 50 | S XMSUBJ="TRANSMISSION ERROR (Non-Textual Body-Part Message [BLOB])"
|
|---|
| 51 | S XMTEXT(1)="Error (sending your Multi-Body-Part Message):"
|
|---|
| 52 | S XMTEXT(2)=" "
|
|---|
| 53 | S XMTEXT(3)="Subject: "_$P(XMR,U)
|
|---|
| 54 | S XMTEXT(4)=" "
|
|---|
| 55 | S XMTEXT(5)=XMSG
|
|---|
| 56 | S XMTEXT(6)=" "
|
|---|
| 57 | S XMTEXT(7)="The message was not sent. It was removed from the transmission queue."
|
|---|
| 58 | S XMTEXT(8)="You should get this problem fixed and reforward this message"
|
|---|
| 59 | S XMSITE=$P(^DIC(4.2,XMINST,0),U)
|
|---|
| 60 | S XMTEXT(9)="to the recipients at "_XMSITE_":"
|
|---|
| 61 | S XMRECIP=":",I=9
|
|---|
| 62 | F S XMRECIP=$O(^XMB(3.9,XMZ,1,"C",XMRECIP)) Q:XMRECIP="" D
|
|---|
| 63 | . S XMIEN=""
|
|---|
| 64 | . F S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMRECIP,XMIEN)) Q:XMIEN="" D
|
|---|
| 65 | . . S XMREC=$G(^XMB(3.9,XMZ,1,XMIEN,0))
|
|---|
| 66 | . . Q:$P($P(XMREC,U,1),"@",2)'=XMSITE
|
|---|
| 67 | . . S I=I+1,XMTEXT(I)=$P(XMREC,U,1)
|
|---|
| 68 | . . S XMFWDBY=$P($G(^XMB(3.9,XMZ,1,XMIEN,"F")),U,2)
|
|---|
| 69 | . . S:XMFWDBY'="" XMTO(XMFWDBY)=""
|
|---|
| 70 | S:'$D(XMTO) XMTO($P(XMR,U,2))="" ; Sender of the message
|
|---|
| 71 | D SENDMSG^XMXSEND(.5,XMSUBJ,"XMTEXT",XMTO,.XMINSTR)
|
|---|
| 72 | Q
|
|---|
| 73 | ;Clean up and quit
|
|---|
| 74 | Q K XMSBLOBT,XMSBLOBX,DIC Q
|
|---|
| 75 | ;
|
|---|
| 76 | TEST S XMSEN="Q",XMREC="S XMRG=250",XMZ=18067
|
|---|
| 77 | G XMS0BLOB
|
|---|
