# This file and maildb.pl make up the server procedures that interface to Perl
# $Header: /u/ra/raines/src/tk/tkmail2/dbperl.tcl,v 1.2 1995/05/22 18:10:07 raines Exp $
global mf mfp mfdb

# GLOBALS
set mfdb(signalprefix) "#.\004."
set mfdb(signalend) "#.\004.END.\004."
set mfdb(signalmime) "#.\004.MIME.\004."
set mfdb(signalmimeend) "#.\004.MIMEEND.\004."
set mfdb(signalexfile) "#.\004.EXFILE.\004."
set mfdb(signallen) [string length $mfdb(signalend)]
set mfdb(last-error) {}
set mfdb(last-errorno) 0
set mfdb(lock-error) 101

#
# ERROR HANDLINE
#
proc mfv:perl-abort { } {
  global mfdb
  while {[string first $mfdb(signalend) [gets stdin]] != 0} { }
  set mfp(perlfree) 1
}

proc mfdb:get-status { line } {
  global mfdb mfp

  set stat [string trim [string range $line $mfdb(signallen) end]]
  if {[catch "expr $stat"]} {
    if $mfp(debug) {puts stderr "INVALID STATUS: $line"}
    set mfdb(last-error) "Invalid status returned from Perl server: $line"
    set mfdb(last-errorno) 999
    return 999
  }
  if {$stat} {
    mfdb:get-last-error
  }
  set mfdb(last-errorno) $stat
  return $stat
}

proc mfdb:get-last-error { } {
  global mfdb
  
  puts stdout "mfdb:last-error"
  flush stdout

  set mfdb(last-error) {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    append mfdb(last-error) $line\n
  }
  return $mfdb(last-error)
}

proc mfdb:perl-eval { args } {
  global mfdb
  
  puts stdout "mfdb:perl-eval\t$args"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

#
# UTILITY
#

proc mfdb:exfile-to-text { tw {prefix {}} } {
  global mfp mfdb

  set tfile [gets stdin]
  if {[catch "open $tfile r" tfid]} {
    mfv:error-mesg "Cannot open temp file $tfile\n$tfid"
    return 255
  } else {
    if [string length $prefix] {
      foreach line [split [read $tfid] \n] {
	$tw insert insert $prefix$line\n
      }
    } else {
      $tw insert insert [read $tfid]
    }
    catch {close $tfid}
    exec rm -f $tfile
  }
  return 0
}

proc mfdb:exfile-to-var { vname {prefix {}} } {
  global mfp mfdb
  upvar $vname var

  set tfile [gets stdin]
  if {[catch "open $tfile r" tfid]} {
    mfv:error-mesg "Cannot open temp file $tfile\n$tfid"
    return 255
  } else {
    if [string length $prefix] {
      foreach line [split [read $tfid] \n] {
	append var $prefix$line\n
      }
    } else {
      set var [read $tfid]
    }
    catch {close $tfid}
    exec rm -f $tfile
  }
  return 0
}

#
# FOLDER
#
proc mfdb:folder-open { folder {readonly 0} } {
  global mfdb mfp
  set mfp(perlfree) 0

  if [file exists ${folder}.lock] {
    if [ut:getok -prompt "The lockfile ${folder}.lock exists. It may be dangerous to proceed. It could be a left over from an improperly exited TkMail session." \
	    -master $mfp(curview) -oklabel "Continue"] {
      catch "exec rm -rf ${folder}.lock"
    } else {
      return 0
    }
  }

  set autofile "[file dirname $folder]/\#[file tail $folder]\#"
  if [file exists $autofile] {
    set prompt "The autosave file $autofile exists "
    if {[file mtime $autofile] > [file mtime $folder]} {
      append prompt "and is more recent. Use the autosave version "
      append prompt "(moving original to ${folder}.bak) or ignore it?"
      if [ut:getok -prompt $prompt \
	      -master $mfp(curview) -oklabel "Use Autosave" -nolabel "Ignore it"] {
	exec mv $folder ${folder}.bak
	exec mv $autofile $folder
      } else {
	exec mv $autofile ${autofile}.bak
      }
    } else {
      append prompt "and is older than original. Delete the autosave file or "
      append prompt "just rename it to $autofile.bak?"
      if [ut:getok -prompt $prompt \
	      -master $mfp(curview) -oklabel "Delete" -nolabel "Rename"] {
	exec rm $autofile
      } else {
	exec mv $autofile ${autofile}.bak
      }
    }
  }

  puts stdout "mfdb:folder-open\t$folder\t$readonly"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  set mfp(perlfree) 1
  return [mfdb:get-status $line]
}

proc mfdb:folder-close { folder } {
  global mfdb
  
  puts stdout "mfdb:folder-close\t$folder"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:folder-backup { folder } {
  global mfdb
  
  puts stdout "mfdb:folder-backup\t$folder"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:folder-summary { folder vname reverse sortkey {start 1} {stop end}} {
  global mfdb mfdb_hdr
  upvar $vname var
  
  puts stdout "mfdb:folder-summary\t$folder\t$start\t$stop\t$reverse\t$sortkey"
  flush stdout

  set var {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    if {[string first $mfdb(signalexfile) $line] == 0} {
      set txt {}
      set ret [mfdb:exfile-to-var txt]
      foreach line [split $txt \n] {
	if {![lempty [string trim $line]]} {lappend var $line}
      }
      while {[string first $mfdb(signalend) [gets stdin]] != 0} { }
      set mfp(perlfree) 1
      return $ret
    } else {
      if {![lempty [string trim $line]]} {lappend var $line}
    }
  }

  return [mfdb:get-status $line]
}

proc mfdb:folder-num-mesgs { filename } {
  global mfdb
  
  puts stdout "mfdb:folder-num-mesgs\t$filename"
  flush stdout

  set num 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set num $line
  }
  mfdb:get-status $line
  return $num
}

proc mfdb:mesg-expand-symbols { folder ndx form vname} {
  global mfdb mfdb_hdr
  upvar $vname var
  
  puts stdout "mfdb:mesg-expand-symbols\t$folder\t$ndx\t$form"
  flush stdout

  set var {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    append var $line
  }

  return [mfdb:get-status $line]
}

proc mfdb:proc-deletes { folder {sorted 0} {sortkey normal}} {
  global mfdb mfdb_hdr
  
  puts stdout "mfdb:proc-deletes\t$folder\t$sorted\t$sortkey"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }

  return [mfdb:get-status $line]  
}

proc mfdb:mail-incorp { folder target vname} {
  global mfdb mfdb_hdr
  upvar $vname var
  
  puts stdout "mfdb:mail-incorp\t$folder\t$target"
  flush stdout

  set var 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set var $line
  }
  return [mfdb:get-status $line]
}

#
# MESSAGES
#
proc mfdb:mesg-save { folder msg target {strip 1} } {
  global mfp mfdb mfdb_hdr
  
  puts stdout "mfdb:mesg-save\t$folder\t$msg\t$target\t$strip"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }

  return [mfdb:get-status $line]  
}

proc mfdb:mesg-delete { folder msgs} {
  global mfdb mfdb_hdr
  
  puts stdout "mfdb:mesg-delete\t$folder\t1\t[join $msgs \t]"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }

  return [mfdb:get-status $line]  
}

proc mfdb:mesg-undelete { folder msgs} {
  global mfdb mfdb_hdr
  
  puts stdout "mfdb:mesg-delete\t$folder\t0\t[join $msgs \t]"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }

  return [mfdb:get-status $line]  
}

proc mfdb:mesg-to-var { folder msg vname {prefix ""} {strip 0}} {
  global mf mfdb mfdb_hdr mfp
  upvar $vname var
  set mfp(perlfree) 0
  
  puts stdout "mfdb:mesg-read\t$folder\t$msg\t$strip"
  flush stdout

  $mfp(tmptxt) delete 1.0 end
  if ($mf(mime-parse)) {
    set stat [mfv:parse-mime-in $folder $msg $mfp(tmptxt) $prefix 1]
    set var [$mfp(tmptxt) get 1.0 end]
    set mfp(perlfree) 1
    return $stat
  } else {
    set var {}
    set line {}
    while {[string first $mfdb(signalend) $line] != 0} {
      while {[string first $mfdb(signalprefix) [set line [gets stdin]]] != 0} {
	append var $prefix$line\n
      }
      if {[string first $mfdb(signalexfile) $line] == 0} {
	set ret [mfdb:exfile-to-var var $prefix]
	while {[string first $mfdb(signalend) [gets stdin]] != 0} { }
	set mfp(perlfree) 1
	return $ret
      }
    }
    set mfp(perlfree) 1
    return [mfdb:get-status $line]
  }
}

proc mfdb:mesg-to-text { folder msg tw ndx {prefix ""} {strip 0} {textonly 0}} {
  global mf mfp mfdb mfdb_hdr
  set mfp(perlfree) 0
  
  puts stdout "mfdb:mesg-read\t$folder\t$msg\t$strip"
  flush stdout

  $tw mark set insert $ndx
  if {!$textonly && ![string length $prefix] && !$strip} {
    while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
      $tw insert insert $line\n
      if {![string length $line]} {
	$tw tag add headers 1.0 "insert -1 line lineend"
	break
      }
    }
    if {[string first $mfdb(signalend) $line] == 0} {
      set mfp(perlfree) 1
      return [mfdb:get-status $line]
    }
  }
  if ($mf(mime-parse)) {
    set ret [mfv:parse-mime-in $folder $msg $tw $prefix $textonly]
    set mfp(perlfree) 1
    return $ret
  } else {
    set line {}
    while {[string first $mfdb(signalend) $line] != 0} {
      while {[string first $mfdb(signalprefix) [set line [gets stdin]]] != 0} {
	$tw insert insert $prefix$line\n
      }
      if {[string first $mfdb(signalexfile) $line] == 0} {
	set ret [mfdb:exfile-to-text $tw $prefix]
	while {[string first $mfdb(signalend) [gets stdin]] != 0} { }
	set mfp(perlfree) 1
	return $ret
      }
    }
    set mfp(perlfree) 1
    return [mfdb:get-status $line]
  }
}

proc mfdb:mesg-full-headers { folder msg tw ndx {prefix ""}} {
  global mf mfdb mfdb_hdr
  
  puts stdout "mfdb:headers-read\t$folder\t$msg\t1"
  flush stdout

  $tw mark set insert $ndx
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    $tw insert insert $prefix$line\n
  }
  return [mfdb:get-status $line]
}

proc mfdb:mesg-headers { folder msg tw }  {
  global mfdb mfdb_hdr

  puts stdout "mfdb:mesg-headers\t$folder\t$msg"
  flush stdout

  catch {unset mfdb_hdr($tw)}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set line [split $line "\004"]
    keylset mfdb_hdr($tw) [lindex $line 0] [lindex $line 1]
  }
  return [mfdb:get-status $line]
}

proc mfdb:mesg-get-header { folder msg field vname }  {
  global mfdb mfdb_hdr
  upvar $vname var

  puts stdout "mfdb:mesg-get-header\t$folder\t$msg\t$field"
  flush stdout

  set var {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    append var $line
  }
  return [mfdb:get-status $line]
}

# append contents of text widget to folder as a new message
#	tw	- text widget
#	target	- folder name
#	vname	- variable name to store number messages written
proc mfdb:text-to-mesg { tw target vname} {
  global mfdb mfdb_hdr
  upvar $vname var
  
  puts stdout "mfdb:mesg-write\t$target"
  puts stdout [$tw get 1.0 end]
  puts stdout $mfdb(signalend)
  flush stdout

  set var 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set var $line
  }
  return [mfdb:get-status $line]
}

#
# FILESYSTEM
#
proc mfdb:file-test { op filename } {
  global mfdb
  
  puts stdout "mfdb:file-test\t$op\t$filename"
  flush stdout

  set ftest 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set ftest $line
  }
  mfdb:get-status $line
  return $ftest
}

proc mfdb:same-files { file1 file2 } {
  global mfdb
  
  puts stdout "mfdb:same-files\t$file1\t$file2"
  flush stdout

  set ftest 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set ftest $line
  }
  mfdb:get-status $line
  return $ftest
}

proc mfdb:mail-check { filename } {
  global mfdb
  
  puts stdout "mfdb:mail-check\t$filename"
  flush stdout

  set ftest 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set ftest $line
  }
  mfdb:get-status $line
  return $ftest
}

proc mfdb:check-append { filename } {
  global mfdb
  
  puts stdout "mfdb:check-append\t$filename"
  flush stdout

  set ftest 0
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set ftest $line
  }
  mfdb:get-status $line
  return $ftest
}

#
# SENDING MAIL
#
proc mfdb:mail-send-old { tw {start 1.0} {stop end} } {
  global mfdb mfdb_hdr
  
  puts stdout "mfdb:mail-send"
  puts stdout [$tw get $start $stop]
  puts stdout $mfdb(signalend)
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:mail-send { tw {start 1.0} {stop end} } {
  global mf mfp

  set cmd {exec $mf(mail-deliver) << \[$tw get $start $stop\] &}
  if {[catch "eval $cmd" res]} {
    mfv:error-mesg $res [winfo toplevel $tw]
    return 255
  } else {
    if $mfp(debug) {puts stderr "Deliver output: $res"}
  }
  return 0
}

proc mfdb:mesg-id { } {
  global mfdb
  
  puts stdout "mfdb:mesg-id"
  flush stdout

  set mesgid {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set mesgid $line
  }
  if {[mfdb:get-status $line]} {
    return {}
  }
  return $mesgid
}

proc mfdb:boundary { } {
  global mfdb
  
  puts stdout "mfdb:boundary"
  flush stdout

  set bound {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    set bound $line
  }
  if {[mfdb:get-status $line]} {
    return {}
  }
  return $bound
}

proc mfdb:run-command { cmd } {
  global mfdb mfdb_hdr

  puts stdout "mfdb:run-command\t$cmd"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

#
# OPTIONS
#
proc mfdb:option-set { opt val } {
  global mfdb
  
  puts stdout "mfdb:option-set\t$opt\t$val"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:option-list-set { opt val } {
  global mfdb
  
  puts stdout "mfdb:option-list-set\t$opt\t[join $val \t]"
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:quit { } {
  global mfdb
  
  puts stdout "mfdb:quit"
  flush stdout
  exit
}

#
# NON-MAIL FILES
#
proc mfdb:file-to-var { filename vname } {
  global mfdb
  upvar $vname var

  puts stdout "mfdb:file-read\t$filename"
  flush stdout

  set var {}
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    lappend var $line
  }
  return [mfdb:get-status $line]
}

proc mfdb:file-to-text { filename tw ndx {prefix ""} } {
  global mfdb

  puts stdout "mfdb:file-read\t$filename"
  flush stdout

  $tw mark set insert $ndx
  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    $tw insert insert $prefix$line\n
  }
  return [mfdb:get-status $line]
}

proc mfdb:var-to-file { vname filename {overwrite 0} } {
  global mfdb mfdb_hdr
  upvar $vname var

  puts stdout "mfdb:file-write\t$filename\t$overwrite"
  puts stdout $var
  puts stdout $mfdb(signalend)
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}

proc mfdb:text-to-file { tw filename {overwrite 0} } {
  global mfdb mfdb_hdr

  puts stdout "mfdb:file-write\t$filename\t$overwrite"
  puts stdout [$tw get 1.0 end]
  puts stdout $mfdb(signalend)
  flush stdout

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
  return [mfdb:get-status $line]
}


