
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 2000 Pacific Marketing and Consulting, Inc.
# Author:  Wayne A. Christopher, wayne@icemcfd.com
#
# The user can open files of the form http://host/filename

if ![info exists url_io] {
    array set url_io {
	user guest
	password guest
	updir /upload/data/icepak
    }
}

proc url_init {args} {
    global url_io
    
    foreach {n v} $args {
	switch $n {
	    user - password - updir {
		set url_io($n) $v
	    }
	}
    }
}

proc url_open {file mode {error_if_fail 1}} {
    global url_io
    
    if {![string match http://* $file]} {
	if !$error_if_fail {
	    if ![file exists $file] { return "" }
	}
	if [catch {open $file $mode} fp] {
	    user_error "$file: $fp"
	    return ""
	} else {
	    return $fp
	}
    }
    for {set i 0} {[file exists .url_tmp_$i]} {incr i} {}
    set tmp .url_tmp_$i
    
    switch $mode {
	r {
	    if ![regexp {http://([^/]+)/(.*)} $file dummy host path] {
		user_error "Bad url $file"
		return ""
	    }
	    set sock [socket $host 80]
	    puts $sock "GET $url_io(updir)/$path"
	    flush $sock
	    set line1 [gets $sock]
	    if [string match "<!DOCTYPE HTML PUBLIC*" $line1] {
		# Maybe not foolproof ...
		if $error_if_fail {
		    user_error "File $file could not be opened"
		    return ""
		} else {
		    close $sock
		    return ""
		}
	    }
	    
	    set fp [open $tmp w]
	    puts $fp $line1
	    while {![eof $sock]} {
		puts $fp [gets $sock]
	    }
	    close $sock
	    close $fp
	    set fp [open $tmp r]
	}
	w {
	    set fp [open $tmp w]
	}
	default { error "bad mode $mode" }
    }
    set url_io($fp,mode) $mode
    set url_io($fp,url) $file
    set url_io($fp,filename) $tmp
    return $fp
}

proc url_close {fp} {
    global url_io
    
    close $fp
    if ![info exists url_io($fp,mode)] return
    
    switch $url_io($fp,mode) {
	r {
	}
	w {
	    set fp [open $url_io($fp,filename) r]
	    set data [read $fp]
	    close $fp
	    
	    if ![regexp {http://([^/]+)/(.*)} $url_io($fp,url) dummy host path] {
		error "Bad url $url_io($fp,url)"
	    }
	    set sock [socket $host 80]
	    puts $sock "PUT /cgi-bin/put_file HTTP/1.0"
	    puts $sock "Content-Type: text/plain"
	    puts $sock "Content-Length: [string length $data]"
	    puts $sock "X-Dest: $url_io(updir)/$path"
	    puts $sock "X-User: $url_io(user)"
	    puts $sock "X-Password: $url_io(password)"
	    
	    puts -nonewline $sock "\n$data"
	    flush $sock
	    set resp [gets $sock]
	    close $sock
	    if ![string match "1 *" $resp] {
		error [string range $resp 2 end]
	    }
	}
    }
    file delete $url_io($fp,filename)
    unset url_io($fp,mode)
    unset url_io($fp,filename)
    unset url_io($fp,url)
}

proc url_source {file {error_if_fail 1}} {
    set fp [url_open $file r $error_if_fail]
    if {$fp == ""} { return 0 }
    
    set data [read $fp]
    url_close $fp
    
    uplevel \#0 $data
    return 1
}

proc url_file_exists {file} {
    set fp [url_open $file r 0]
    if {$fp == ""} {
	return 0
    } else {
	url_close $fp
	return 1
    }
}

proc url_report_error {host proxy proxyport user from_email subject data \
			   {server_proc send_error}} {
    global url_report_error_lock is_win

    if [info exists url_report_error_lock] return
    
    if 1 { # don't ever try to send email using mapimail
      if {$proxy == ""} {
	set proxy $host
	set proxyport 80
	set url /cgi-bin/$server_proc
      } else {
	set url http://$host/cgi-bin/$server_proc
      }
	puts "url is $url; proxy is $proxy"
      #set len [expr [string length $data] + [llength [split data \n]]]
      set len [expr [string length $data] + 2]
      if [catch {set sock [socket $proxy $proxyport]} sk_err] {
         return "socket error: $wk_err"
      }
      puts $sock "PUT $url HTTP/1.0"
      puts $sock "Content-Type: text/plain"
      puts $sock "Content-Length: $len"
      puts $sock "X-For-User: $user"
      puts $sock "X-From-User: $from_email"
      puts $sock "X-Subject: $subject"
    
      puts $sock "\n$data"
      flush $sock
    
      while {![eof $sock]} {
	  if [catch {gets $sock} resp] {
	      puts "Error: $resp"
	      continue
	  }
	  puts $resp
	  if [regexp "Error has been successfully reported" $resp] {
	    close $sock
	    return ""
	  }
      }
      close $sock
      return [string range $resp 2 end]
    } else {
      set err [url_mapimail_report_error $host $subject $data] 
#
#  Another way to send email: requires proxy on windows systems, works also on unix-like systems
#  Required: tcllib1.4 to be installed  
#
#      set err [smtp_send_message $host $from_email $subject $data $proxy $proxyport]
#
      return $err
    }
}

# CREDITS: The mapimail.dll is from Michael I. Schwartz (mschwart@nyx.net).

proc url_mapimail_send_message {to subject data attachments} {
    set err ""
    set here [pwd]
    set err [url_mapimail_load] 
    cd $here ;# this likes to cd to outlook's directory for some reason
    if {$err != ""} { return "url_mapimail_load: $err" }
    if ![url_mapimail_enabled] { return "url_mapimail_enabled: 0" }
    set err [url_mapimail_logon]
    if {$err != ""} { return "url_mapimail_logon: $err" }
    set err [url_mapimail_send $to $subject $data $attachments]
    if {$err != ""} { set err "url_mapimail_send: $err" }
    url_mapimail_logoff
    return $err
}

proc url_mapimail_report_error {to subject data {attachments ""}} {
    set err ""
    set here [pwd]
    set err [url_mapimail_load] 
    cd $here ;# this likes to cd to outlook's directory for some reason
    if {$err != ""} { return "url_mapimail_load: $err" }
    if ![url_mapimail_enabled] { cd $here; return "url_mapimail_enabled: 0" }
    set err [url_mapimail_logon]
    cd $here ;# this likes to cd to mozilla's directory for some reason
    if {$err != ""} { return "url_mapimail_logon: $err" }
    set err [url_mapimail_send $to $subject $data $attachments]
    if {$err != ""} { set err "url_mapimail_send: $err" }
    url_mapimail_logoff
    cd $here ;# just to be sure
    return $err
}

proc url_mapimail_load {} {
    set ret ""
    if [catch {package require mapimail} err] {
      if [catch {load ./mapimail.dll} err] {
        set ret $err
      }
    }
    return $ret
}

proc url_mapimail_logon {} {
    set ret ""
    if [catch {mapimail logon} err] {
      set ret $err
    }
    return $ret
}

proc url_mapimail_logoff {} {
    mapimail logoff
}

proc url_mapimail_enabled {} {
    return [mapimail enabled]
}

proc url_mapimail_send {to subject body attachments} {
    set ret ""
    if [catch {mapimail send -to $to -subject "$subject" -body "$body" -attachments $attachments} err] {
        if [catch {mapimail send -to $to -subject "$subject" -body "$body" -debug} err] {
            set ret $err
        }
    }
    return $ret
}

proc send_email {to subject body} {
}


proc smtp_send_message {to from subject body {servers localhost} {ports 25}} {
    global env
    
    if {[catch {package require smtp} err] || [catch {package require mime} err]} {
        if ![file exists $env(ICEPAK_ROOT)/lib/tcllib1.4] {
            return "missing tcllib1.4"
        }
        set path $env(ICEPAK_ROOT)/lib/tcllib1.4        
        uplevel \#0 source \"$path/md5/md5.tcl\"
        uplevel \#0 source \"$path/base64/base64.tcl\"
        uplevel \#0 source \"$path/mime/mime.tcl\"
        uplevel \#0 source \"$path/mime/smtp.tcl\"
    }
    if [catch {package require smtp} err] { return "$err" }
    if [catch {package require mime} err] { return "$err" }
    set token [mime::initialize -canonical text/plain -string "$body"]
    mime::setheader $token Subject "$subject"
    smtp::sendmessage $token -recipients "$to" -servers "$servers" \
                             -originator "$from" -ports "$ports"
    mime::finalize $token
    return ""
}


