home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / metamail / contrib / ServiceMail / src / services / register.tcl < prev    next >
Encoding:
Text File  |  1993-05-07  |  673 b   |  22 lines
  1. # register - register a service with the directory
  2. #
  3. # 9-July-92 weber@eitech.com created
  4. #
  5. proc register {switches envelope inputs} {
  6.     if {[getfield $inputs TYPE] == "multipart"} {
  7.     set parts [getfield $inputs PARTS]
  8.     return [register $switches $envelope \
  9.                  [lindex $parts [expr [llength $parts] - 1]]]
  10.     } {
  11.     set fid [open [glob "~/archive/directory"] a]
  12.     puts $fid "--+"
  13.     puts $fid [format "Administrator: %s\n" [getfield $envelope REPLYTO]]
  14.     set gid [open [getfield $inputs FILE] r]
  15.     puts $fid [read $gid]
  16.     close $fid
  17.     close $gid
  18.     setfield response STRING "Thanks for registering your service."
  19.     return [mailout [turnaround $envelope] $response]
  20.     }
  21. }
  22.