home *** CD-ROM | disk | FTP | other *** search
- # get
- #
- # 25-Jun-92 weber@eitech.com updated to new parameter format
- # 29-May-92 weber@eitech.com
- #
- # This service scans through a message body for postscript source, and
- # sends what it found to the printer. If the input is a multipart, it
- # scans through the last body in the multipart. It also does a check
- # to see if the address is local (it won't print otherwise).
- #
- # This service retrieves files from an archive. Patterns describing
- # the desired files are in switches, or in the single body; all matching
- # archive files are bundled into the output message
- #
-
- proc dofetch {switches envelope inputs} {
- if {[llength $switches] == 0} {
- set switches [exec cat [getfield $inputs FILE]]
- if {[llength $switches] == 0} {set switches "info.txt"}
- }
- cd ~/archive
- set hits {}
- foreach pattern $switches {
- set foo [glob -nocomplain $pattern]
- #Now we preprocess foo to make sure it doesn't have any verboten chars
- if {
- [string match /* $foo]||[string match ~* $foo]
- ||[string match ../* $foo]||[regexp /../ $foo]
- ||[string match .\\./ $foo]||[regexp /.\\./ $foo]
- } then {
- #Some sort of warning routine should go here...
- } else { set hits [concat $hits $foo]}
-
- }
- case [llength $hits] {
- 0 { setfield response STRING "No files found in archive that match \"$switches\"." }
- 1 {
- if {[file readable $hits]} {
- setfield response FILE $hits
- setfield response DESCRIPTION "the archive file you requested"
- setmimetype response
- } {
- setfield response STRING "Sorry, I could not retrieve the file $hits."
- }
- }
- default {
- setfield response TYPE multipart
- setfield response SUBTYPE mixed
- setfield response DESCRIPTION "the archive files you requested"
- foreach hit $hits {
- set part {}
- if {[file readable $hit]} {
- setfield part FILE $hit
- setmimetype part
- } {
- setfield part STRING "Sorry, I could not retrieve the file $hit."
- }
- lappend parts $part
- }
- setfield response PARTS $parts
- }
- }
- return [mailout [turnaround $envelope] $response]
- }
-
- proc setmimetype {objectname} {
- # set up filename as call-by-name
- upvar $objectname object
- set filename [getfield $object FILE]
- case $filename {
- *.ps { setfield object TYPE application; setfield object SUBTYPE postscript }
- *.tex { setfield object TYPE text; setfield object SUBTYPE x-latex }
- *.c { setfield object TYPE application; setfield object SUBTYPE x-c }
- *.sh { setfield object TYPE application; setfield object SUBTYPE x-sh }
- *.tar.Z { setfield object TYPE application
- setfield object SUBTYPE octet-stream
- setfield params name $filename
- setfield params type tar
- setfield params conversions compress
- setfield object PARAMS $params
- }
- *.tar { setfield object TYPE application
- setfield object SUBTYPE octet-stream
- setfield params name $filename
- setfield params type tar
- setfield object PARAMS $params
- }
- }
- }
-