| 1 | XMR0BLOB ;(WASH ISC)/CAP-BLOB Receive ;09/15/97 09:28
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine receives 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 later capability is planned to receive TCP/IP-SMTP messaes that
|
|---|
| 10 | ;conform to MIME (MEE-MEE), an extension to RFC-822 that MailMan will
|
|---|
| 11 | ;conform to.
|
|---|
| 12 | ;
|
|---|
| 13 | ;Message Protocol Data Unit (MPDU) received in X (from XMR0A) contains:
|
|---|
| 14 | ;
|
|---|
| 15 | ;file_name^BLOB_name^BLOB_type^Origin Date
|
|---|
| 16 | ;(Eg. X="XIMAGE.756^XRAY2-ulna^STLL IMAGE^2930430
|
|---|
| 17 | ;API entry requires Path, Netmail entry automatically defaults it
|
|---|
| 18 | ;
|
|---|
| 19 | ;Returns: 250 Okay file_path
|
|---|
| 20 | ;
|
|---|
| 21 | BLOB(X) ;Receive BLOB
|
|---|
| 22 | ;
|
|---|
| 23 | ;Reject BLOBs
|
|---|
| 24 | I '$D(^DD(2005)) S XMSG="555 Reject - Imaging not installed at "_^XMB("NETNAME"),ER=1 X XMSEN G Q
|
|---|
| 25 | ;Cannot recieve BLOB without REGISTERED SUBDIRECTORY in DOMAIN file
|
|---|
| 26 | F Q:$E(X)'=" " S X=$E(X,2,999)
|
|---|
| 27 | ;
|
|---|
| 28 | S %=$G(^DIC(4.2,XMINST,"FTP/DIR"))
|
|---|
| 29 | ;FTP DIRECTORY (File 4.2, Field 6.7) -- Sub-directory for a domain
|
|---|
| 30 | ;
|
|---|
| 31 | ;Receive message into Kernel Site Parameter DISK/VOL (7.7) entry
|
|---|
| 32 | S Y=$G(^XMB(1,1,"DISK/VOL"))
|
|---|
| 33 | I %_Y="",'$L($P($G(^XMB(1,1,"FTPRCVDISK")),U)) S XMSG="550 Reject - No DISK/VOL or DOMAIN Directory defined in Kernel Site Parameters at "_^XMB("NETNAME") X XMSEN G Q
|
|---|
| 34 | S XMR0BLOB("DISK")=Y_$S(%="":"",1:$S($L(Y,"\")>1:"",1:"\"))_%
|
|---|
| 35 | ;
|
|---|
| 36 | S XMR0BLOB("FILE")=$P(X,U),XMR0BLOB("NAME")=$P(X,U,2),XMR0BLOB("TYPE")=$P(X,U,3),XMR0BLOB("FTP")=Y,XMR0BLOB("DATE")=$P(X,U,4)
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | FILE K DIC
|
|---|
| 40 | ;First make sure pointer fields exist in pointed at files
|
|---|
| 41 | ;Network Location
|
|---|
| 42 | ;Is it there ?
|
|---|
| 43 | S X=$P($G(^XMB(1,1,"FTPNETLOC")),U),X=$S($L(X):X,1:"MAG1"),DIC=2005.2,DIC(0)="XF" D ^DIC
|
|---|
| 44 | ;If not there set it up
|
|---|
| 45 | I Y<0 D FILE^DICN
|
|---|
| 46 | S XMR0BLOB("DISK")=Y
|
|---|
| 47 | ;
|
|---|
| 48 | ;(TYPE)
|
|---|
| 49 | ;Is it there ?
|
|---|
| 50 | K DIC S DIC=2005.02,DIC(0)="FX",X=XMR0BLOB("TYPE") D ^DIC
|
|---|
| 51 | ;If not there set it up
|
|---|
| 52 | I Y<0 D FILE^DICN
|
|---|
| 53 | S XMRBLOB("TYPE")=+Y
|
|---|
| 54 | ;
|
|---|
| 55 | ;Is it already in the file ?
|
|---|
| 56 | S X=XMR0BLOB("NAME"),DIC="^MAG(2005,",DIC(0)="FO" D ^DIC I +Y>0 S XMSG="442 File previously exists",X=$$2005(Y) X XMSEN G Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;Finally it's time to stuff the entry in the master file
|
|---|
| 59 | ;Sends: FTP Address^ ^ ^ ^ Path ^ Username ^ Password ^ Physical Disk
|
|---|
| 60 | ;EG. 250 Okay^1.2.0.1^^^image\subdir^USERNAME^PASSWORD^_nfa0:
|
|---|
| 61 | S XMSG="250 Okay ^"_$G(^XMB(1,1,"FTP-RCV"))_"^^^"_$G(^("DISK/VOL"))_U_$G(^("FTPUSER"))_U_$G(^("FTPPWD"))_U_$P($G(^("FTPRCVDISK")),U)
|
|---|
| 62 | X XMSEN G Q:ER
|
|---|
| 63 | S DIC="^MAG(2005,",DIC(0)="FI",X=XMR0BLOB("NAME") D FILE^DICN
|
|---|
| 64 | S DIE="^MAG(2005,",DR="2///"_+XMR0BLOB("DISK")_";1///"_XMR0BLOB("FILE")_";3///"_XMR0BLOB("TYPE")_$S($L(XMR0BLOB("DATE")):";14///"_XMR0BLOB("DATE"),1:""),DA=+Y
|
|---|
| 65 | D ^DIE S X=$$2005(DA)
|
|---|
| 66 | Q K DO,DD,DIC,DO,DD,DA,XMR0BLOB
|
|---|
| 67 | Q
|
|---|
| 68 | 2005(X) ;Add to Message BLOB list
|
|---|
| 69 | N XMFDA
|
|---|
| 70 | S XMFDA(3.92005,"?+1,"_$G(XMZIENS,XMZ_","),.01)=X
|
|---|
| 71 | D UPDATE^DIE("","XMFDA")
|
|---|
| 72 | Q 1
|
|---|
| 73 | API(X) ;BLOB (XMD,XMB)
|
|---|
| 74 | N %,I,XMMG,XMR0BLOB,XMSEN,XMSG,XMREC
|
|---|
| 75 | F %=1:1:5 S XMR0BLOB($P("FILE^TYPE^NAME^DATE^DISK",U,I))=$P(X,U,I)
|
|---|
| 76 | D FILE
|
|---|
| 77 | Q $S(+XMSG=250:1,+XMSG=440:1,1:0)
|
|---|
