- XMR0BLOB ;(WASH ISC)/CAP-BLOB Receive ;09/15/97 09:28
- ;;8.0;MailMan;;Jun 28, 2002
- ;
- ;This routine receives BLOBS (Basic Large OBjects), also known in the
- ;messaging world as 'Other Body Parts' of messages.
- ;It can do this only with Mailman systems after (not including)
- ;version 7.0.
- ;
- ;A later capability is planned to receive TCP/IP-SMTP messaes that
- ;conform to MIME (MEE-MEE), an extension to RFC-822 that MailMan will
- ;conform to.
- ;
- ;Message Protocol Data Unit (MPDU) received in X (from XMR0A) contains:
- ;
- ;file_name^BLOB_name^BLOB_type^Origin Date
- ;(Eg. X="XIMAGE.756^XRAY2-ulna^STLL IMAGE^2930430
- ;API entry requires Path, Netmail entry automatically defaults it
- ;
- ;Returns: 250 Okay file_path
- ;
- BLOB(X) ;Receive BLOB
- ;
- ;Reject BLOBs
- I '$D(^DD(2005)) S XMSG="555 Reject - Imaging not installed at "_^XMB("NETNAME"),ER=1 X XMSEN G Q
- ;Cannot recieve BLOB without REGISTERED SUBDIRECTORY in DOMAIN file
- F Q:$E(X)'=" " S X=$E(X,2,999)
- ;
- S %=$G(^DIC(4.2,XMINST,"FTP/DIR"))
- ;FTP DIRECTORY (File 4.2, Field 6.7) -- Sub-directory for a domain
- ;
- ;Receive message into Kernel Site Parameter DISK/VOL (7.7) entry
- S Y=$G(^XMB(1,1,"DISK/VOL"))
- 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
- S XMR0BLOB("DISK")=Y_$S(%="":"",1:$S($L(Y,"\")>1:"",1:"\"))_%
- ;
- 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)
- ;
- ;
- FILE K DIC
- ;First make sure pointer fields exist in pointed at files
- ;Network Location
- ;Is it there ?
- S X=$P($G(^XMB(1,1,"FTPNETLOC")),U),X=$S($L(X):X,1:"MAG1"),DIC=2005.2,DIC(0)="XF" D ^DIC
- ;If not there set it up
- I Y<0 D FILE^DICN
- S XMR0BLOB("DISK")=Y
- ;
- ;(TYPE)
- ;Is it there ?
- K DIC S DIC=2005.02,DIC(0)="FX",X=XMR0BLOB("TYPE") D ^DIC
- ;If not there set it up
- I Y<0 D FILE^DICN
- S XMRBLOB("TYPE")=+Y
- ;
- ;Is it already in the file ?
- 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
- ;
- ;Finally it's time to stuff the entry in the master file
- ;Sends: FTP Address^ ^ ^ ^ Path ^ Username ^ Password ^ Physical Disk
- ;EG. 250 Okay^127.0.0.1^^^image\subdir^USERNAME^PASSWORD^_nfa0:
- S XMSG="250 Okay ^"_$G(^XMB(1,1,"FTP-RCV"))_"^^^"_$G(^("DISK/VOL"))_U_$G(^("FTPUSER"))_U_$G(^("FTPPWD"))_U_$P($G(^("FTPRCVDISK")),U)
- X XMSEN G Q:ER
- S DIC="^MAG(2005,",DIC(0)="FI",X=XMR0BLOB("NAME") D FILE^DICN
- S DIE="^MAG(2005,",DR="2///"_+XMR0BLOB("DISK")_";1///"_XMR0BLOB("FILE")_";3///"_XMR0BLOB("TYPE")_$S($L(XMR0BLOB("DATE")):";14///"_XMR0BLOB("DATE"),1:""),DA=+Y
- D ^DIE S X=$$2005(DA)
- Q K DO,DD,DIC,DO,DD,DA,XMR0BLOB
- Q
- 2005(X) ;Add to Message BLOB list
- N XMFDA
- S XMFDA(3.92005,"?+1,"_$G(XMZIENS,XMZ_","),.01)=X
- D UPDATE^DIE("","XMFDA")
- Q 1
- API(X) ;BLOB (XMD,XMB)
- N %,I,XMMG,XMR0BLOB,XMSEN,XMSG,XMREC
- F %=1:1:5 S XMR0BLOB($P("FILE^TYPE^NAME^DATE^DISK",U,I))=$P(X,U,I)
- D FILE
- Q $S(+XMSG=250:1,+XMSG=440:1,1:0)
- XMR0BLOB ;(WASH ISC)/CAP-BLOB Receive ;09/15/97 09:28
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ;
- +3 ;This routine receives BLOBS (Basic Large OBjects), also known in the
- +4 ;messaging world as 'Other Body Parts' of messages.
- +5 ;It can do this only with Mailman systems after (not including)
- +6 ;version 7.0.
- +7 ;
- +8 ;A later capability is planned to receive TCP/IP-SMTP messaes that
- +9 ;conform to MIME (MEE-MEE), an extension to RFC-822 that MailMan will
- +10 ;conform to.
- +11 ;
- +12 ;Message Protocol Data Unit (MPDU) received in X (from XMR0A) contains:
- +13 ;
- +14 ;file_name^BLOB_name^BLOB_type^Origin Date
- +15 ;(Eg. X="XIMAGE.756^XRAY2-ulna^STLL IMAGE^2930430
- +16 ;API entry requires Path, Netmail entry automatically defaults it
- +17 ;
- +18 ;Returns: 250 Okay file_path
- +19 ;
- BLOB(X) ;Receive BLOB
- +1 ;
- +2 ;Reject BLOBs
- +3 IF '$DATA(^DD(2005))
- SET XMSG="555 Reject - Imaging not installed at "_^XMB("NETNAME")
- SET ER=1
- XECUTE XMSEN
- GOTO Q
- +4 ;Cannot recieve BLOB without REGISTERED SUBDIRECTORY in DOMAIN file
- +5 FOR
- IF $EXTRACT(X)'=" "
- QUIT
- SET X=$EXTRACT(X,2,999)
- +6 ;
- +7 SET %=$GET(^DIC(4.2,XMINST,"FTP/DIR"))
- +8 ;FTP DIRECTORY (File 4.2, Field 6.7) -- Sub-directory for a domain
- +9 ;
- +10 ;Receive message into Kernel Site Parameter DISK/VOL (7.7) entry
- +11 SET Y=$GET(^XMB(1,1,"DISK/VOL"))
- +12 IF %_Y=""
- IF '$LENGTH($PIECE($GET(^XMB(1,1,"FTPRCVDISK")),U))
- SET XMSG="550 Reject - No DISK/VOL or DOMAIN Directory defined in Kernel Site Parameters at "_^XMB("NETNAME")
- XECUTE XMSEN
- GOTO Q
- +13 SET XMR0BLOB("DISK")=Y_$SELECT(%="":"",1:$SELECT($LENGTH(Y,"\")>1:"",1:"\"))_%
- +14 ;
- +15 SET XMR0BLOB("FILE")=$PIECE(X,U)
- SET XMR0BLOB("NAME")=$PIECE(X,U,2)
- SET XMR0BLOB("TYPE")=$PIECE(X,U,3)
- SET XMR0BLOB("FTP")=Y
- SET XMR0BLOB("DATE")=$PIECE(X,U,4)
- +16 ;
- +17 ;
- FILE KILL DIC
- +1 ;First make sure pointer fields exist in pointed at files
- +2 ;Network Location
- +3 ;Is it there ?
- +4 SET X=$PIECE($GET(^XMB(1,1,"FTPNETLOC")),U)
- SET X=$SELECT($LENGTH(X):X,1:"MAG1")
- SET DIC=2005.2
- SET DIC(0)="XF"
- DO ^DIC
- +5 ;If not there set it up
- +6 IF Y<0
- DO FILE^DICN
- +7 SET XMR0BLOB("DISK")=Y
- +8 ;
- +9 ;(TYPE)
- +10 ;Is it there ?
- +11 KILL DIC
- SET DIC=2005.02
- SET DIC(0)="FX"
- SET X=XMR0BLOB("TYPE")
- DO ^DIC
- +12 ;If not there set it up
- +13 IF Y<0
- DO FILE^DICN
- +14 SET XMRBLOB("TYPE")=+Y
- +15 ;
- +16 ;Is it already in the file ?
- +17 SET X=XMR0BLOB("NAME")
- SET DIC="^MAG(2005,"
- SET DIC(0)="FO"
- DO ^DIC
- IF +Y>0
- SET XMSG="442 File previously exists"
- SET X=$$2005(Y)
- XECUTE XMSEN
- GOTO Q
- +18 ;
- +19 ;Finally it's time to stuff the entry in the master file
- +20 ;Sends: FTP Address^ ^ ^ ^ Path ^ Username ^ Password ^ Physical Disk
- +21 ;EG. 250 Okay^127.0.0.1^^^image\subdir^USERNAME^PASSWORD^_nfa0:
- +22 SET XMSG="250 Okay ^"_$GET(^XMB(1,1,"FTP-RCV"))_"^^^"_$GET(^("DISK/VOL"))_U_$GET(^("FTPUSER"))_U_$GET(^("FTPPWD"))_U_$PIECE($GET(^("FTPRCVDISK")),U)
- +23 XECUTE XMSEN
- IF ER
- GOTO Q
- +24 SET DIC="^MAG(2005,"
- SET DIC(0)="FI"
- SET X=XMR0BLOB("NAME")
- DO FILE^DICN
- +25 SET DIE="^MAG(2005,"
- SET DR="2///"_+XMR0BLOB("DISK")_";1///"_XMR0BLOB("FILE")_";3///"_XMR0BLOB("TYPE")_$SELECT($LENGTH(XMR0BLOB("DATE")):";14///"_XMR0BLOB("DATE"),1:"")
- SET DA=+Y
- +26 DO ^DIE
- SET X=$$2005(DA)
- Q KILL DO,DD,DIC,DO,DD,DA,XMR0BLOB
- +1 QUIT
- 2005(X) ;Add to Message BLOB list
- +1 NEW XMFDA
- +2 SET XMFDA(3.92005,"?+1,"_$GET(XMZIENS,XMZ_","),.01)=X
- +3 DO UPDATE^DIE("","XMFDA")
- +4 QUIT 1
- API(X) ;BLOB (XMD,XMB)
- +1 NEW %,I,XMMG,XMR0BLOB,XMSEN,XMSG,XMREC
- +2 FOR %=1:1:5
- SET XMR0BLOB($PIECE("FILE^TYPE^NAME^DATE^DISK",U,I))=$PIECE(X,U,I)
- +3 DO FILE
- +4 QUIT $SELECT(+XMSG=250:1,+XMSG=440:1,1:0)
