Patch title: Release 85 bulk changes
Abstract:
File: /pliant/appli/mail.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/appli/mail/database.pli"
module "/pliant/protocol/smtp/mail.pli"
module "/pliant/protocol/smtp/meta.pli"
module "/pliant/protocol/smtp/forward.pli"
module "/pliant/protocol/smtp/spam.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"
module "/pliant/util/encoding/base64.pli"
module "/pliant/util/encoding/qp.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/util/encoding/neutral.pli"
module "/pliant/util/encoding/http.pli"
module "/pliant/util/crypto/random.pli"
module "/pliant/language/schedule/resourcesem.pli"
module "/pliant/protocol/smtp/mime.pli"

constant emil_is_available (file_query "embedded:/usr/bin/emil" standard)=success
if emil_is_available
  module "/pliant/language/stream/pipe.pli"
  module "/pliant/admin/execute.pli"

function smart_name s -> n
  arg Str s n
  if not (s parse "[dq]" any:n "[dq]" any) or n=""
    if not (s parse any:n "<" any) or n=""
      if not (s parse any "<" any:n ">" any) or n=""
        n := s
    
function stripped_name n -> s
  arg Str n s
  if not (n parse any "<" any:s ">" any)
    n parse any:s

    
function mail_path -> p
  arg Str p
  p := this_computer:env:"pliant":"mail":"path"
  if p=""
    p := "data:/pliant/mail/"


type MimeStream
  field Pointer:Stream stream
  field Str name mime
  field CBool embedded <- false
  field CBool html <- false
  field Int encoding
  field List:Str boundaries

method ms multipart -> c
  arg MimeStream ms ; arg CBool c
  c := (exists ms:boundaries:first) or ms:embedded

method ms bind s reset
  arg_rw MimeStream ms ; arg_rw Stream s ; arg CBool reset
  ms stream :> s
  ms name := ""
  ms mime := ""
  ms embedded := false
  ms html := false
  ms encoding := 0
  if reset
    ms boundaries := var List:Str empty_list


function ms_decode l
  arg_rw Str l
  if (l eparse any:(var Str head) "=?" any:(var Str charset) "?" any:(var Str enc) "?" any:(var Str value) "?=" any:(var Str tail))
    if lower:enc="q"
      ms_decode tail
      l := head+qp_decode:value+tail
    eif lower:enc="b"
      ms_decode tail
      l := head+base64_decode:value+tail

method ms header_line l -> c
  arg_rw MimeStream ms ; arg_w Str l ; arg CBool c
  l := ms:stream readline
  if l=""
    return false
  while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" }
    l += ms:stream readline
  if (l parse acword:"content-type" ":" any:(var Str value) ";" any)
    ms mime := value
  if (l parse acword:"content-type" ":" acword:"message" any)
    ms embedded := true
  if (l parse acword:"content-type" ":" acword:"text" "/" word:"html" any)
    ms html := true
  if (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any)
    ms boundaries += value
  eif (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value))
    ms boundaries += value
  if (l parse acword:"content-transfer-encoding" ":" any acword:"base64" any)
    ms encoding := 1
  eif (l parse acword:"content-transfer-encoding" ":" any acword:"quoted-printable" any)
    ms encoding := 2
  eif (l parse acword:"content-transfer-encoding" ":" any)
    ms encoding := 3
  # Novell unstandard encoding
  if (l parse acword:"content-disposition" ":" any acword:"filename" "=" "[dq]" any:(var Str value) "[dq]" any)
    ms_decode value
    ms name := value
  if (l parse acword:"content-type" ":" any acword:"name" "=" "[dq]" any:(var Str value) "[dq]" any)
    ms_decode value # cope with crazy Microsoft encoding
    ms name := value
  c := true


method ms body_line l -> c
  arg_rw MimeStream ms ; arg_w Str l ; arg CBool c
  if ms:stream:atend
    return false
  l := ms:stream readline
  if (l 0 2)="--"
    var Pointer:Str b :> ms:boundaries first
    while exists:b
      if l="--"+b or l="--"+b+"--"
        return false
      b :> ms:boundaries next b
  if ms:encoding=1 # base64
    l := base64_decode l
  eif ms:encoding=2 # quoted printable
    if l:len>0 and (l l:len-1)="="
      l := qp_decode (l 0 l:len-1)
    else
      l := qp_decode:l+"[lf]"
  else
    l += "[lf]"
  if ms:embedded  
    while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" }
      l += ms:stream readline
    if (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any)
      ms boundaries += value
    eif (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value))
      ms boundaries += value
    if l=""
      ms embedded := false
  c := true


#----------------------------------------------------------------------
#  send


function mail_reset user
  arg Str user
  mail_database2:data:current delete user
  file_tree_delete mail_path+"attach/"+user+"/"


function mail_reply user mailbox filename all
  arg Str user mailbox filename ; arg CBool all
  (var Stream s) open filename in+safe+anyeol
  (var MimeStream ms) bind s true ; var Str from subject ; var List:Str to cc
  while (ms header_line (var Str l))
    if (l parse acword:"subject" ":" any:(var Str value))
      ms_decode value
      subject := value
    eif (l parse acword:"from" ":" any:(var Str value))
      from := value
    eif (l parse acword:"to" ":" any:(var Str value))
      while value<>""
        if not (value parse any:(var Str first) "," any:(var Str remain))
          first := value ; remain := ""
        if first<>mailbox and not (first parse any "<" pattern:mailbox ">" any)
          to += first
        value := remain
    eif (l parse acword:"cc" ":" any:(var Str value))
      while value<>""
        if not (value parse any:(var Str first) "," any:(var Str remain))
          first := value ; remain := ""
        if first<>mailbox and not (first parse any "<" pattern:mailbox ">" any)
          cc += first
        value := remain
  var Str body := smart_name:from+" wrote:[lf]>[lf]"
  if not ms:multipart
    while (ms body_line l)
      body += "> "+l
  else
    while (ms body_line l)
      void
    while not s:atend
      ms bind s false
      while (ms header_line l)
        void
      while (ms body_line l)
        if ms:name="" and ms:mime="text/plain"
          body += "> "+l
  mail_reset user
  mail_database2:data:current create user
  var Data:MailCurrent current :> mail_database2:data:current user
  current from := mailbox
  current:target create ""         
  current:target:"" box := from
  if all   
    var Pointer:Str t :> to first
    while exists:t
      var Str id := generate_id
      current:target create id         
      current:target:id box := t
      t :> to next t
    var Pointer:Str t :> cc first
    while exists:t
      var Str id := generate_id
      current:target create id         
      current:target:id box := t
      current:target:id mode := "cc"
      t :> cc next t
  current subject := shunt (lower:subject parse "re:" any) subject "Re: "+subject
  current body := body


function mail_send user area -> status
  arg Str user area ; arg Status status
  part build "build mail file"
    var Data:MailCurrent current :> mail_database2:data:current user
    var Data:MailBox m :> mailbox current:from
    if not exists:m
      return failure
    var DateTime timestamp := datetime
    timestamp split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction)
    var Str id := generate_id
    (var Stream s) open m:out_path+id+".tmp" out+cr+lf+safe+mkdir
    # console "sending message " user " in file " s:name eol
    var (Link Database:MailMeta) db :> new Database:MailMeta
    db load m:out_path+id+".pdb"
    var Data:MailMeta meta :> db data
    meta queued_on := timestamp
    var Str from := (mailbox current:from):name
    from := from+(shunt from<>"" " " "")+"<"+current:from+">"
    s writeline "From: "+from
    meta from := from
    var Str tos := "" ; var Str ccs := ""
    each t current:target
      if t:box<>""
        if (t:box parse word:"all" any:(var Str keyword))
          each ubm user_database2:data:user:user:bookmark
            if ubm:mailbox<>"" and (keyword="" or (ubm:keywords parse any word:keyword any))
              var Str id2 := "b"+keyof:ubm
              var Str box2 := ubm:name+" <"+ubm:mailbox+">"
              meta:target create id2
              meta:target:id2:box := box2
              if t:mode<>"cc"
                tos += (shunt tos<>"" ",[lf]  " "")+box2
              else
                ccs += (shunt ccs<>"" ",[lf]  " "")+box2
        else
          var Str id2 := keyof t
          meta:target create id2
          meta:target:id2:box := t box
          if t:mode<>"cc"
            tos += (shunt tos<>"" ",[lf]  " "")+t:box
          else
            ccs += (shunt ccs<>"" ",[lf]  " "")+t:box
    if tos<>""
      s writeline "To: "+tos
    if ccs<>""
      s writeline "Cc: "+ccs
    s writeline "Subject: "+current:subject
    s writeline "Date: "+rfc1123_date:timestamp
    s writeline "Message-ID: <"+generate_id+"@"+computer_fullname+">"
    s writeline "X-Mailer: Pliant "+string:pliant_release_number
    var Array:FileInfo attached := file_list mail_path+"attach/"+user+"/" standard+relative
    if attached:size>0
      var Str boundary := (repeat 8 "-")
      for (var Int i) 1 (max 128\8\uInt:size 1)
        var uInt rnd ; memory_strong_random addressof:rnd Int:size
        boundary += string rnd "radix 36"
      s writeline "MIME-Version: 1.0"
      s writeline "Content-Type: multipart/mixed; boundary=[dq]"+(boundary 2 boundary:len)+"[dq]"
    else
      s writeline "Content-Type: text/plain; charset=iso-8859-1"
      s writeline "Content-Transfer-Encoding: 8bit"
    s writeline ""
    if attached:size=0
      s writeline current:body
    else
      s writeline "This is a multi-part message in MIME format."
      s writeline boundary
      s writeline "Content-Type: text/plain; charset=iso-8859-1"
      s writeline "Content-Transfer-Encoding: 8bit"
      s writeline ""
      s writeline current:body
      for (var Int i) 0 attached:size-1
        s writeline boundary
        s writeline "Content-Type: application/octet-stream; name=[dq]"+attached:i:name+"[dq]"
        s writeline "Content-Transfer-Encoding: base64"
        s writeline "Content-Disposition: attachment; filename=[dq]"+attached:i:name+"[dq]"
        s writeline ""
        part attach "encode attached file"
          (var Stream a) open mail_path+"attach/"+user+"/"+attached:i:name in+safe
          while not a:atend
            a read_available (var Address adr) (var Int step) 54
            if step=54
              (var Str bytes) set adr step false
            else
              bytes set (memory_allocate step null) step true
              memory_copy adr bytes:characters step
              while bytes:len<54 and not a:atend
                a read_available (var Address adr) (var Int step) 54-bytes:len
                (var Str extra) set adr step false
                bytes += extra
            s writeline base64_encode:bytes
      s writeline boundary+"--"
    s close
    db store
  var Str apath := m:archive_path+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"
  file_tree_create apath
  if (file_clone m:out_path+id+".tmp" apath+id+".mail")=failure
    file_copy m:out_path+id+".tmp" apath+id+".mail"
  if area<>""
    if (file_clone m:out_path+id+".tmp" m:area_path+area+"/"+id+".mail")=failure
      file_copy m:out_path+id+".tmp" m:area_path+area+"/"+id+".mail"
  file_move m:out_path+id+".tmp" m:out_path+id+".mail"
  file_directory_flush m:out_path+id+".mail"
  file_hook m:out_path+id+".mail"
  file_hook m:out_path+id+"pdb"
  forward_mails
  forward_mail m:out_path+id+".mail" true "forward a just posted mail" 
  status := success


method page mail_edit user
  arg_rw HtmlPage page ; arg Str user
  mail_database2:data:current create user
  var Data:MailCurrent current :> mail_database2:data:current:user
  implicit page
    title "Send a mail"
    table columns 3 border 0
      cell [From]
      cell
        each umb user:user:mailbox
          if current:from=""
            current:from := umb
        select "" current:from
          each umb user:user:mailbox
            option umb umb
      cell void
      each t current:target
        if t:box<>"" and keyof:t<>""
          cell
            text t:mode
          cell
            text t:box
          cell
            button "Delete"
              current:target delete keyof:t
              reload_page
      current:target create ""
      cell
        select "" current:target:"":mode
          option "To" "to"
          option "Cc" "cc"
      cell
        var Str cvalue := current:target:"":box
        select "" current:target:"":box noeol
          option "" ""
          var CBool already := false
          each ubm user_database2:data:user:user:bookmark filter ubm:mailbox<>"" and (current:keyword="" or (ubm:keywords parse any (word current:keyword) any)) sort ubm:name+" "+ubm:first_name
            var Str blabel := (shunt ubm:first_name<>"" ubm:first_name+" " "")+ubm:name
            var Str bvalue := blabel+" <"+ubm:mailbox+">"
            option blabel bvalue
          if current:keyword<>""
            option "all "+current:keyword "all "+current:keyword
        input "" current:target:"":box length 30 noeol
      cell
        button "One more line"
          var Str id := string datetime:seconds
          current:target create id
          data_copy current:target:"" current:target:id
          current:target delete ""
          reload_page
      cell [Subject]
      cell
        input "" current:subject length 40
      cell void
    text_input "Message:[lf]" current:body columns 80 rows 20
    var Array:FileInfo files := file_list mail_path+"attach/"+user+"/" standard+relative
    if files:size>0
      var Intn total := 0
      table columns 3
        cell header [Attached file]
        cell header [Size in bytes]
        cell void
        for (var Int i) 0 files:size-1
          cell
            text files:i:name
          cell
            text (string files:i:size)
          cell
            var Str attached_file := files:i:name
            small
              button "discard"
                file_delete mail_path+"attach/"+user+"/"+attached_file
                reload_page
          total += files:i:size
        cell header [Total]
        cell
          text string:total+" ("+(string (total+2^19)\2^20)+" MB)"
        cell void
    file_upload "File name: " (var Str attach) noeol
    button "Attach the file"
      var Str remote := attach option "remote_name" Str
      file_move attach mail_path+"attach/"+user+"/"+remote
      reload_page
    para
      button "Reset the mail" noeol
        title "Reset the mail"
        [Are you sure you want to reset the mail content without sending it ?] ; eol
        button "Yes" noeol
          mail_reset user
          goto_backward
        button "No"
          goto_backward
      button "Save the current content" noeol
        reload_page
      button "Preview then send"
        goto_url "preview" no_extension
    para
      input "Keyword: " current:keyword noeol
      button "Select bookmarks matching the keyword"
        reload_page
      

method page mail_preview user
  arg_rw HtmlPage page ; arg Str user
  mail_database2:data:current create user
  var Data:MailCurrent current :> mail_database2:data:current:user
  implicit page
    table columns 1
      cell color lsh 80 5 60
      cell color (color hsl 50 5 75)
        table columns 2 border 0
          cell [From:]
          cell
             text current:from
          each t current:target
            if t:box<>""
              cell
                text (shunt t:mode<>"cc" "To:" "Cc:")
              cell
                text t:box
          cell [Subject:]
          cell
            bold
              text current:subject
    fixed
      text current:body
    var Array:FileInfo files := file_list mail_path+"attach/"+user+"/" standard+relative
    if files:size>0
      para
        var Intn total := 0
        table columns 2
          cell header [Attached file]
          cell header [Size in bytes]
          for (var Int i) 0 files:size-1
            cell
              text files:i:name
            cell
              text (string files:i:size)
            total += files:i:size
          cell header [Total]
          cell
            text string:total+" ("+(string (total+2^19)\2^20)+" MB)"
    para
      var Str area
      button "Send it" noeol
        mail_send user area
        mail_reset user
        goto_backward 2
      var Data:MailBox m :> mailbox current:from
      var Array:FileInfo areas := file_list m:area_path standard+relative+directories
      if areas:size<>0     
        select "and store in in area " area noeol
          option "" ""
          for (var Int i) 0 areas:size-1
            var Str area := areas:i:name
            area := area 0 (area search "/" area:len)
            option neutral_decode:area area
            option http_decode:area area
      eol
      button "Edit again"
        goto_backward


#----------------------------------------------------------------------
# read


method page send_mime_part filename part filter emil -> status
  arg_rw HtmlPage page ; arg Str filename part filter ; arg CBool emil ; arg Status status
  var List:Str boundaries
  var Stream s
  if emil_is_available and emil
    stream_pipe (var Str in_stream) (var Str out_stream)
    execute "emil -F MIME -B BA" root "embedded:/" input filename output out_stream detached
    s open in_stream in+safe+anyeol
  else 
    s open filename in+safe+anyeol
  (var MimeStream ms) bind s true
  while (ms header_line (var Str l))
    void
  if ms:multipart
    while (ms body_line l)
     void
    while not s:atend
      ms bind s false
      while (ms header_line l)
        void
      if ms:name=part and (filter<>"html" or ms:mime="text/html") and ms:mime<>"application/applefile"
        if emil_is_available and ms:encoding=3 and not emil
        if emil_is_available and ms:encoding_model=undefined and not emil
           page send_mime_part filename part filter true
          return          
        var Str temp := file_temporary
        (var Stream t) open temp out+safe
        while (ms body_line l)
          t writechars l
        t close
        var Str ext := lower:part (part search_last "." part:len) part:len
        if ext=".htm"
          ext := ".html"
        page reset_http_answer
        page:http_request send_static_file temp "filter_"+(shunt filter<>"" filter ext)
        file_delete temp
        return success
      else
        while (ms body_line l)
          void
  status := failure


method page mail_display user box filename buttons back_level options
  arg_rw HtmlPage page ; arg Str user ; arg Data:MailBox box ; arg Str filename ; arg Str buttons ; arg Int back_level ; arg Str options
  implicit page
    if options="raw"
      reset_http_answer
      http_request send_static_file filename "filter_ascii"
      return
    var CBool detailed := options="detailed"
    var Str subject
    var Str from
    var List:Str tos
    var List:Str ccs
    var Str date
    var List:Str extras
    var List:Str boundaries
    var CBool quoted := false
    var CBool spam := false
    (var Stream s) open filename in+safe+anyeol
    (var MimeStream ms) bind s true
    while (ms header_line (var Str l))
      if (l parse acword:"subject" ":" any:(var Str value))
        ms_decode value
        subject := value
      eif (l parse acword:"from" ":" any:(var Str value))
        ms_decode value
        from := value
      eif (l parse acword:"to" ":" any:(var Str value))
        ms_decode value
        tos += value
      eif (l parse acword:"cc" ":" any:(var Str value))
        ms_decode value
        ccs += value
      eif (l parse acword:"date" ":" any:(var Str value))
        date := value
      eif (l parse acword:"spam" any)
        spam := true
      if detailed
        extras += l
    table columns 1
      cell color lsh 80 5 60
      cell color (color hsl 60 5 75)
        table columns 2 border 0
          if from<>""
            cell [From:]
            cell
              if (from parse "[dq]" any:(var Str realname) "[dq]" "<" any:(var Str remain))
                 bold text:realname ; text " <"+remain
              eif (from parse any:(var Str realname) "<" any:(var Str remain))
                 bold text:realname ; text "<"+remain
              else
                text from
          if (exists tos:first)
            cell [To:]
            cell
              var Pointer:Str to :> tos first
              while exists:to
                text to ; eol
                to :> tos next to
          if (exists ccs:first)
            cell [Cc:]
            cell
              var Pointer:Str cc :> ccs first
              while exists:cc
                text cc ; eol
                cc :> ccs next cc
          if subject<>""
            cell [Subject:]
            cell (bold text:subject)
          if date<>""
            cell [Date:]
            cell text:date
          if options=""
            cell void
            cell
          cell void
          cell
            if options<>"detailed"
              small (link "detailed header" "" options "detailed" no_extension)
            if options<>"raw"
              fixed [ ] ; small (link "raw text" "" options "raw" no_extension)
              if (exists boundaries:first)
                fixed [ ] ; small [(this is a multipart message)]
              fixed [ ]
              small
                if spam
                  note "not a spam"
                    set_spam_mark filename false
                    reload_page
                else
                  note "a spam"
                    set_spam_mark filename true
                    reload_page
            if (exists boundaries:first)
              fixed [ ] ; small [(this is a multipart message)]
            fixed [ ]
            small
              if spam
                note "not a spam"
                  set_spam_mark filename false
                  reload_page
              else
                note "a spam"
                  set_spam_mark filename true
                  reload_page
            fixed [ ]
            small
              page note "spam rating"
                spam_load_dictionary (box smart_path "")+"spam_filter.txt" (var (Dictionary Str Float) filter) (var Float unknown_threshold) (var Float spam_threshold)
                var Float rating := spam_filter filename filter (var Str report)
                text "Spam probability for this mail is avaluated to "+(string rating*100 "fixed 0")+"%" ; eol
                text "Your current unknown threshold is "+(string unknown_threshold*100 "fixed 0")+"%, "
                text "and your current spam threshold is "+(string spam_threshold*100 "fixed 0")+"%, "
                text "so this one would be "+(shunt rating>spam_threshold "rejected" rating>unknown_threshold "unknown" "accepted")+"."
                para
                  [Detailed spam filter report:] ; eol
                  fixed text:report
      cell
        if detailed
          small
            var Pointer:Str extra :> extras first
            while exists:extra
              text extra ; eol
              extra :> extras next extra
        if (buttons search "R" -1)<>(-1)
          button "reply" noeol
            mail_reply user keyof:box filename false
            goto_url (repeat back_level "../")+"send" no_extension
          button "reply to all" noeol
            mail_reply user keyof:box filename true
            goto_url (repeat back_level "../")+"send" no_extension
        if (buttons search "D" -1)<>(-1)
          button "delete" noeol
            file_delete filename
            file_hook filename
            goto_backward
        if (buttons search "B" -1)<>(-1)
          var Str mailbox := stripped_name from
          var (Data Set:UserBookmark) bookmark :> user_database2:data:user:user:bookmark
          var CBool already := false
          each b2 bookmark
            if b2:mailbox=mailbox
              already := true
          if not already 
            page button "Add to bookmarks" noeol
              bookmark create mailbox
              var Data:UserBookmark b :> bookmark mailbox
              b name := smart_name from
              b mailbox := mailbox
              title "New bookmark"
              table columns 2
                cell [Name: ]
                cell (input "" b:name length 40)
                cell [Abstract: ]
                cell (text_input "" b:abstract columns 60 rows 5)
                cell [Mailbox: ]
                cell (input "" b:mailbox length 40)
                cell [Home page / URL: ]
                cell (input "" b:url length 40)
                cell [Contact: ]
                cell (text_input "" b:contact columns 60 rows 5)
                cell [Keywords: ]
                cell (input "" b:keywords length 60)
              button "Record" noeol
                goto_backward
              button "Cancel bookmark creation"
                bookmark delete mailbox
                goto_backward
        if (buttons search "M" -1)<>(-1)
          var Array:FileInfo areas := file_list box:area_path standard+relative+directories
          if areas:size<>0     
            fixed [  ]
            select "Area: " (var Str area) noeol
              for (var Int i) 0 areas:size-1
                var Str area := areas:i:name
                area := area 0 (area search "/" area:len)
                option neutral_decode:area area
                option http_decode:area area
            button "move to area" noeol
              var Str base := filename (filename search_last "/" filename:len)+1 filename:len
              file_move filename box:area_path+area+"/"+base
              goto_backward
    if ms:html
    if options="raw" or spam
      fixed
        (var Stream s) open filename in+safe
        while not s:atend
          s read_available (var Address adr) (var Int size) 256
          (var Str chars) set adr size false
          text chars
    eif ms:html
      while (ms body_line l)
        html l
    eif  ms:multipart
      while (ms body_line l)
        void
      while not s:atend
        var List:Str extras := var List:Str empty_list
        ms bind s false
        while (ms header_line l)
          if detailed
            extras += l
        if ms:name<>""
          if ms:mime<>"application/applefile"
            table columns (shunt detailed 3 2)
              cell
                if (ms:name (ms:name search_last "." ms:name:len) ms:name:len)=".htm"
                  link ms:name (neutral_encode ms:name) options "html" no_extension
                  link ms:name (http_encode ms:name) options "html" no_extension
                else
                  link ms:name (neutral_encode ms:name) no_extension
                  link ms:name (http_encode ms:name) no_extension
              cell
                small (link "view" (neutral_encode ms:name) options "ascii" no_extension)
                fixed [ ] ; small (link "download" (neutral_encode ms:name) options "binary" no_extension)
                small (link "view" (http_encode ms:name) options "ascii" no_extension)
                fixed [ ] ; small (link "download" (http_encode ms:name) options "binary" no_extension)
              if detailed
                cell
                  small
                    var Pointer:Str extra :> extras first
                    while exists:extra
                      text extra ; eol
                      extra :> extras next extra
            while (ms body_line l)
              void
          else
            while (ms body_line l)
              void
        eif ms:mime="text/html"
          table columns 2 border 0
            cell color lsh 90 0 0
            cell color (color hsl 0 0 90)
              var CBool body := false ; var CBool nobody := false
              while (ms body_line l)
                if (l parse "<" word:"BODY" any ">" any:(var Str remain)) or (l parse "<" word:"body" any ">" any:(var Str remain))
                  l := remain ; body := true
                if (reverse:l parse (pattern reverse:"</HTML>") any:(var Str remain)) or (reverse:l parse (pattern reverse:"</html>") any:(var Str remain))
                  l := reverse remain
                if (reverse:l parse (pattern reverse:"</BODY>") any:(var Str remain)) or (reverse:l parse (pattern reverse:"</body>") any:(var Str remain))
                  l := reverse remain ; nobody := true
                if body
                  html l
                if nobody
                  body := false ; nobody := false
            cell color lsh 90 0 0
            cell color (color hsl 0 0 90)
              small (link "view" "" options "html" no_extension)
        else
          fixed
            while (ms body_line l)
              text l
    else
      fixed
        while (ms body_line l)
          text l

method page mail_list box filepath subpath
  arg_rw HtmlPage page ; arg Data:MailBox box ; arg Str filepath subpath

method page mail_list category box filepath subpath
  arg_rw HtmlPage page ; arg Str category ; arg Data:MailBox box ; arg Str filepath subpath
  implicit page
    var Array:FileInfo files := file_list filepath standard+relative+sorted
    if files:size>0
      if exists:box  
        [Mails received in] ; fixed (text " "+keyof:box)
        text upper:(category 0 1)+(category 1 category:len)+"s received in" ; fixed (text " "+keyof:box)
      table columns 3
        cell header [From]
        cell header [Subject]
        cell void
        for (var Int i) 0 files:size-1
          if files:i:extension=".mail"
            var Str filename := filepath+files:i:name
            var Str from := "" ; var Str subject := ""
            (var Stream s) open filename in+safe+anyeol
            (var MimeStream ms) bind s true
            while (ms header_line (var Str l))
              if (l parse acword:"from" ":" any:(var Str from1))
                ms_decode from1
                from := from1
              if (l parse acword:"subject" ":" any:(var Str subject1))
                ms_decode subject1
                subject := subject1
            cell
              text smart_name:from
            cell
              link (shunt subject<>"" subject "no subject") subpath+files:i:stripped_name+"/" no_extension
            cell
              small
                note "delete"
                  file_delete filename
                  file_hook filename
                  reload_page
                fixed [ ]
                if (subpath eparse "in/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/in/") any:(var Str head))
                  note "a spam"
                    var Str spam := reverse:head+"/spam/"+reverse:tail
                    file_tree_create spam
                    file_move filename spam
                    set_spam_mark spam true
                    file_hook filename
                    file_hook spam
                    reload_page
                eif (subpath eparse "spam/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/spam/") any:(var Str head))
                eif ( (subpath eparse "unknown/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/unknown/") any:(var Str head)) ) or ( (subpath eparse "spam/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/spam/") any:(var Str head)) )
                  note "not a spam"
                    var Str normal := reverse:head+"/in/"+reverse:tail
                    file_tree_create normal
                    file_move filename normal
                    set_spam_mark normal false
                    file_hook filename
                    file_hook normal
                    reload_page

method page spam_list box filepath subpath
  arg_rw HtmlPage page ; arg Data:MailBox box ; arg Str filepath subpath
  implicit page
    var Array:FileInfo files := file_list filepath standard+relative
    if files:size>0
      note (string files:size)+" spam"+(shunt files:size>1 "s" "")
        var DateTime timestamp := datetime
        title "Spams received in "+keyof:box
        mail_list box filepath subpath
        button "Delete all at once"
          var Array:FileInfo spams := file_list filepath standard
          for (var Int i) 0 spams:size-1
            if spams:i:datetime<timestamp
              file_delete spams:i:name
          goto_backward
      [ received in] ; fixed (text " "+keyof:box) ; eol


method page mail_list user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    title "'"+user+"' mailboxes"
    each umb user:user:mailbox
      var Data:MailBox m :> mailbox umb
      if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
        mail_list m m:in_path "in/"+domain+"/"+box+"/"
    para
      each umb user:user:mailbox
        var Data:MailBox m :> mailbox umb
        if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
          spam_list m m:spam_path "spam/"+domain+"/"+box+"/"
        mail_list "mail" m m:in_path "in/"+domain+"/"+box+"/"
    each umb user:user:mailbox
      var Data:MailBox m :> mailbox umb
      if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
        var Array:FileInfo files := file_list m:out_path standard+relative
        if files:size>0
          [Mails sent from] ; fixed (text " "+keyof:m)
          table columns 3
            cell header [To]
            cell header [Subject]
            cell void
            for (var Int i) 0 files:size-1
              if files:i:extension=".mail"
                var Str subject := ""
                (var Stream s) open m:out_path+files:i:name in+safe
                (var MimeStream ms) bind s true
                while (ms header_line (var Str l))
                  if (l parse acword:"subject" ":" any:(var Str subject1))
                    subject := subject1
                var (Link Database:MailMeta) db :> new Database:MailMeta
                db load m:out_path+files:i:stripped_name+".pdb"
                var Data:MailMeta meta :> db data
                cell
                  each t meta:target
                    if t:status="S"
                      color lsh 0 75 120
                      font color (color hsl 120 0 75)
                        text (smart_name t:box) ; eol
                    eif t:status="R"
                      color lsh 50 100 0
                      font color (color hsl 0 100 50)
                        text (smart_name t:box) ; eol
                    eif (t:last_error parse word:"sending" any)
                      color lsh 80 80 60
                      font color (color hsl 60 80 80)
                        text (smart_name t:box) ; eol
                    eif t:last_error<>""
                      color lsh 80 80 30
                      font color (color hsl 30 80 80)
                        text (smart_name t:box) ; eol
                    else
                      text (smart_name t:box) ; eol
                cell
                  text subject
                cell
                  var Str name := m:out_path+files:i:stripped_name
                  note "details"
                    var (Link Database:MailMeta) db2 :> new Database:MailMeta
                    db2 load name+".pdb"
                    var Data:MailMeta meta2 :> db2 data
                    table columns 6
                      cell header [Target mailbox]
                      cell header [Status]
                      cell header [Try count]
                      cell header [Last tryed on]
                      cell header [... to server]
                      cell header [... reported error]
                      each t2 meta2:target
                        cell
                          text t2:box
                        if t2:status="S"
                          cell color lsh 80 30 120
                          cell color (color hsl 120 30 80)
                            [Sent]
                        eif t2:status="R"
                          cell color lsh 80 30 0
                          cell color (color hsl 0 30 80)
                            [Rejected]
                        eif (t2:last_error parse word:"sending" any)
                          cell color lsh 80 30 60
                          cell color (color hsl 60 30 80)
                            [Currently sending]
                        eif t2:last_error<>""
                          cell color lsh 80 30 30
                          cell color (color hsl 30 30 80)
                            [Temporary rejected]
                        else
                          cell
                            [Not tried yet]
                        cell
                          text (string t2:try_count)
                        cell
                          text (string t2:last_try)
                        cell
                          text t2:last_server
                        cell
                          if (t2:last_error parse word:"sending" any:(var Str meter))
                            text meter
                          else
                            text t2:last_error
                    button "Try to forward now" noeol
                      forward_mail name+".mail" false "try to forward a mail right now"
                      goto_backward
                    if allowed:"advanced_mail"
                      button "Forward to any SMTP server of the target domain" noeol
                        forward_path name+".mail" "" "indirect"
                        forward_mail name+".mail" false "try to forward a mail to anybody right now"
                        goto_backward
                    if this_computer:env:"pliant":"mail":"forward_isp"<>""
                      button "Forward to our ISP" noeol
                        forward_path name+".mail" this_computer:env:"pliant":"mail":"forward_isp" ""
                        forward_mail name+".mail" false "try to forward a mail to our ISP right now"
                        goto_backward
                    button "Delete"
                      file_delete name+".mail"
                      file_delete name+".pdb"
                      file_hook name+".mail"
                      file_hook name+".pdb"
                      goto_backward
                            
      else
        text "Mailbox "+keyof:m+" is not defined !"
        
method page spam_list user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    para
      table columns 2 border 0
        cell
          var Int total := 0
          each umb user:user:mailbox
            var Data:MailBox m :> mailbox umb
            if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
              var Array:FileInfo unknown := file_list m:unknown_path standard+relative
              var Array:FileInfo spam := file_list m:spam_path standard+relative
              if unknown:size>0 or spam:size>0
                small
                  fixed (text keyof:m+": ")
                  if unknown:size>0
                    text (string unknown:size)+" unknown mail"+(shunt unknown:size>1 "s" "")
                  if unknown:size>0 and spam:size>0
                    [, ]
                  if spam:size>0
                    text (string spam:size)+" spam"+(shunt spam:size>1 "s" "")
                  eol
                total += unknown:size+spam:size
        cell
          if total>0
            page note "spams cleanup"
              var DateTime timestamp := datetime
              title "Spams cleanup"
              for (var Int lap) 0 1
                each umb user:user:mailbox
                  var Data:MailBox m :> mailbox umb
                  if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
                    para
                      mail_list (shunt lap=0 "unknown mail" "spam") m (shunt lap=0 m:unknown_path m:spam_path) (shunt lap=0 "unknown" "spam")+"/"+domain+"/"+box+"/"
              page button "Delete all at once"
                for (var Int lap) 0 1
                  each umb user:user:mailbox
                    var Data:MailBox m :> mailbox umb
                    if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
                      var Array:FileInfo spams := file_list (shunt lap=0 m:unknown_path m:spam_path) standard
                      for (var Int i) 0 spams:size-1
                        if spams:i:datetime<timestamp
                          file_delete spams:i:name
                goto_backward


#----------------------------------------------------------------------
# search


method page mail_search user
  arg_rw HtmlPage page ; arg Str user
  var Data:MailCurrent current :> mail_database2:data:current:user
  implicit page
    title "Search in the mail archives"
    table columns 2 border 0
      cell [From]
      cell (input "" (var Str from) length 30)
      cell [To/Cc]
      cell (input "" (var Str to) length 30)
      cell [Subject]
      cell (input "" (var Str subject) length 30)
      cell [Content]
      cell (text_input "" (var Str content) columns 30 rows 3)
      cell [Raw content]
      cell (text_input "" (var Str raw) columns 30 rows 3)
      cell [Days]
      var Int days := 30
      cell (input "" days length 5)
    button "Search now"
      part search "search mail archives"
        title "Mail archives search result"
        var Array:Str contents ; var Array:CBool content_oks
        while content<>""
          if not (content parse any:(var Str first) "[lf]" any:(var Str remain))
            first := content ; remain := ""
          if first<>""
            contents += lower first ; content_oks += false
          content := remain
        var Array:Str raws ; var Array:CBool raw_oks
        while raw<>""
          if not (raw parse any:(var Str first) "[lf]" any:(var Str remain))
            first := raw ; remain := ""
          if first<>""
            raws += lower first ; raw_oks += false
          raw := remain
        para
          [Search for mails:]
          list
            if from<>""
              item
                [containing] ; fixed (text " "+from+" ") ; [in the from field.] ; eol
            if to<>""
              item
                [containing] ; fixed (text " "+to+" ") ; [in one of the to or cc fields.] ; eol
            if subject<>""
              item
                [containing] ; fixed (text " "+subject+" ") ; [in the subject field.] ; eol
            for (var Int i) 0 contents:size-1
              item
                [containing] ; fixed (text " "+contents:i+" ") ; [in the body of the message.] ; eol
            for (var Int i) 0 raws:size-1
              item
                [containing] ; fixed (text " "+raws:i+" ") ; [in the raw message.] ; eol
            item
              [received at most] ; fixed (text " "+string:days+" ") ; [days ago.] ; eol
        table columns 4
          cell header [Date]
          cell header [From]
          cell header [To]
          cell header [Subject]
          var Date today := datetime date
          for (var Int j) days 0 step -1
            today-j split (var Int year) (var Int month) (var Int day)
            each umb user:user:mailbox
              var Data:MailBox m :> mailbox umb
              if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
                var Str apath := m:archive_path+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"
                var Array:FileInfo files := file_list apath standard+sorted
                for (var Int i) 0 files:size-1
                  part scan_one "scan mail "+files:i:name
                    var Str from2 := "" ; var Str to2 := "" ; var Str subject2 := "" ; var Str boundary := ""
                    var CBool from_ok := false
                    var CBool to_ok := false
                    var CBool subject_ok := false
                    (var Stream s) open files:i:name in+safe+anyeol
                    (var MimeStream ms) bind s true
                    while (ms header_line (var Str l))
                      if (l parse acword:"from" ":" any:(var Str value))
                        ms_decode value
                        if from<>"" and (lower:value search lower:from -1)<>(-1)
                          from_ok := true
                        from2 := value
                      eif (l parse acword:"to" ":" any:(var Str value)) or (l parse acword:"cc" ":" any:(var Str value))
                        ms_decode value
                        if to<>"" and (lower:value search lower:to -1)<>(-1)
                          to_ok := true
                        to2 += (shunt to2<>"" "," "")+value
                      eif (l parse acword:"subject" ":" any:(var Str value))
                        ms_decode value
                        if subject<>"" and (lower:value search lower:subject -1)<>(-1)
                          subject_ok := true
                        subject2 := value
                    if (from<>"" and not from_ok) or (to<>"" and not to_ok) or (subject<>"" and not subject_ok)
                      leave scan_one
                    if contents:size>0
                      for (var Int u) 0 content_oks:size-1
                        content_oks u := false
                      if not ms:multipart
                        while (ms body_line l)
                          l := lower l
                          for (var Int u) 0 content_oks:size-1
                            if (l search contents:u -1)<>(-1)
                              content_oks u := true
                      else
                        part scan_mime_parts
                          while (ms body_line l)
                            void
                          while not s:atend
                            ms bind s false
                            while (ms header_line l)
                              void
                            if ms:name="" and ms:mime="text/plain"
                              while (ms body_line l)
                                l := lower l
                                for (var Int u) 0 content_oks:size-1
                                  if (l search contents:u -1)<>(-1)
                                    content_oks u := true
                            eif ms:name<>""
                              leave scan_mime_parts
                            else
                              while (ms body_line l)
                                void
                      for (var Int u) 0 content_oks:size-1
                        if not content_oks:u
                          leave scan_one
                    if raws:size>0
                      for (var Int u) 0 raw_oks:size-1
                        raw_oks u := false
                      s configure "seek 0"
                      while not s:atend
                        var Str l := lower s:readline
                        for (var Int u) 0 raw_oks:size-1
                          if (l search raws:u -1)<>(-1)
                            raw_oks u := true
                      for (var Int u) 0 raw_oks:size-1
                        if not raw_oks:u
                          leave scan_one
                    cell
                      text (string today-j)
                    cell
                      text smart_name:from2
                    cell
                      small
                        while to2<>""
                          if not (to2 parse any:(var Str value) "," any:(var Str remain))
                            value := to2 ; remain := ""
                          text smart_name:value ; eol
                          to2 := remain
                    cell
                      link (shunt subject2<>"" subject2 "no subject") "archive/"+domain+"/"+box+"/"+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"+files:i:stripped_name+"/" no_extension
    para
      [A search on the raw content is slow.]
                

method page mail_bookmarks user
  arg_rw HtmlPage page ; arg Str user
  user_database2:data:user create user
  var (Data Set:UserBookmark) bookmark :> user_database2:data:user:user:bookmark
  implicit page
    title "'"+user+"' bookmarks"
    table columns 5
      cell header [Line ID]
      cell header [First name]
      cell header [Name]
      cell header [Keywords]
      cell void
      each b bookmark sort b:name+" "+b:first_name
        cell
          text keyof:b
        cell
          text b:first_name
        cell
          text b:name
        cell
          text b:keywords
        cell
          button "Edit"
            title "Bookmark"
            table columns 2
              cell [First name: ]
              cell (input "" b:first_name length 40)
              cell [Name: ]
              cell (input "" b:name length 40)
              cell [Abstract: ]
              cell (text_input "" b:abstract columns 60 rows 5)
              cell [Mailbox: ]
              cell (input "" b:mailbox length 40)
              cell [Home page / URL: ]
              cell (input "" b:url length 40)
              cell [Contact: ]
              cell (text_input "" b:contact columns 60 rows 5)
              cell [Keywords: ]
              cell (input "" b:keywords length 60)
            button "Record"
              goto_backward
    input "Line ID: " (var Str lid) noeol
    button "Create the bookmark" noeol
      bookmark create lid
      reload_page
    button "Delete the bookmark"
      bookmark delete lid
      reload_page


method page mail_create_area user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    title "Create a new mail area"
    select "In which mailbox: " (var Str box)
      each umb user:user:mailbox
        option umb umb
    input "New area name: " (var Str name)
    button "Create it"
      var Data:MailBox b :> mailbox box
      if exists:b
        file_tree_create b:area_path+neutral_encode:name+"/"
        file_tree_create b:area_path+http_encode:name+"/"
      goto_backward

method page mail_delete_area user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    title "Delete a new mail area"
    select "Area: " (var Str what)
      option "" ""
      each umb user:user:mailbox
        var Array:FileInfo areas := file_list mailbox:umb:area_path standard+directories+relative
        for (var Int i) 0 areas:size-1
          if (file_list mailbox:umb:area_path+areas:i:name standard):size=0
            var Str name := areas:i:name
            name := name 0 (name search_last "/" name:len)
            option neutral_decode:name+" in "+umb+" mailbox" string:umb+" "+(string areas:i:name)
            option http_decode:name+" in "+umb+" mailbox" string:umb+" "+(string areas:i:name)
    button "Delete it"
      if (what parse (var Str mailbox) (var Str area))
        each umb user:user:mailbox
          if umb=mailbox
            file_delete mailbox:umb:area_path+area+"/"
      goto_backward
    para
      [You can delete an area only if it is empty.]

method page set_spam_filter user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    title "Set the spam filter"
    select "In which mailbox: " (var Str box)
    var Str box := "all"
    select "Set spam filter for " box
      each umb user:user:mailbox
        option umb umb
    var Int days := 30
    input "Study mail archives on " days length 3 noeol ; [ days] ; eol
        option "mailbox "+umb umb
      option "all mailboxes" "all"
    var Int days := 120
    input "studying " days length 3 noeol ; [ days mail archives] ; eol
    var Float unknown_threshold100 := 50
    input "using an unknown threshold of " unknown_threshold100 length 4 noeol ; [%] ; eol
    var Float spam_threshold100 := 90
    input "and a spam threshold of " spam_threshold100 length 4 noeol ; [%] ; eol
    var Int vdays := 120
    input "then test the filter against " vdays length 3 noeol ; [days mail archives] ; eol
    page button "set spam filter" noeol
      var Data:MailBox mb :> mailbox box
      var DateTime limit := datetime ; limit seconds -= days*86400
      spam_ip_study mb:archive_path limit (mb smart_path "")+"spam_ip.txt"
      spam_word_study mb:archive_path limit (mb smart_path "")+"spam_word.txt"
      goto_backward
      var Array:Str mailboxes paths
      each umb1 user:user:mailbox
        var Data:MailBox m1 :> mailbox umb1
        if exists:m1 and (keyof:m1=box or box="all")
          mailboxes += keyof m1 ; paths += m1 archive_path
      var Str temp := file_temporary
      var DateTime since := datetime ; since seconds -= days*86400
      spam_study paths since unknown_threshold100/100 spam_threshold100/100 temp
      for (var Int i) 0 mailboxes:size-1
        var Data:MailBox m1 :> mailbox mailboxes:i
        file_copy temp (m1 smart_path "")+"spam_filter.txt"
        file_delete (m1 smart_path "")+"spam_ip.txt" # old ones
        file_delete (m1 smart_path "")+"spam_word.txt"
      spam_load_dictionary temp (var (Dictionary Str Float) filter) (var Float unknown_threshold) (var Float spam_threshold)
      file_delete temp
      var DateTime since := datetime ; since seconds -= vdays*86400
      var Int count := 0
      for (var Int p) 0 paths:size-1
        var Array:FileInfo files := file_list paths:p standard+recursive+relative
        for (var Int i) 0 files:size-1
          if files:i:datetime>=since
            count += 1
      var Int spam_rejected := 0 ; var Int spam_unknown := 0 ; var Int spam_accepted := 0
      var Int valid_rejected := 0 ; var Int valid_unknown := 0 ; var Int valid_accepted := 0
      table columns 5
        cell header [Date]
        cell header [From]
        cell header [To]
        cell header [Subject]
        cell header [Rating]
        var Int current := 0
        for (var Int p) 0 paths:size-1
          var Array:FileInfo files := file_list paths:p standard+recursive+relative
          for (var Int i) 0 files:size-1
            if files:i:datetime>=since
              current += 1
              part test "test mail filter "+string:current+"/"+string:count
                (var Stream s) open paths:p+files:i:name in+safe
                var CBool spam := s:readline parse acword:"spam" any
                s close
                var Float rating := spam_filter paths:p+files:i:name filter (var Str report)
                var Int level := shunt rating>spam_threshold 1 rating>unknown_threshold 0 -1
                if spam
                  if level>0
                    spam_rejected += 1
                  eif level=0
                    spam_unknown += 1
                  else
                    spam_accepted += 1
                else
                  if level>0
                    valid_rejected += 1
                  eif level=0
                    valid_unknown += 1
                  else
                    valid_accepted += 1
                if (spam and level<0) or (not spam and level>0)
                  var Str from2 := "" ; var Str to2 := "" ; var Str subject2 := ""
                  (var Stream s) open paths:p+files:i:name in+safe+anyeol
                  (var MimeStream ms) bind s true
                  while (ms header_line (var Str l))
                    if (l parse acword:"from" ":" any:(var Str value))
                      ms_decode value
                      from2 := value
                    eif (l parse acword:"to" ":" any:(var Str value)) or (l parse acword:"cc" ":" any:(var Str value))
                      ms_decode value
                      to2 += (shunt to2<>"" "," "")+value
                    eif (l parse acword:"subject" ":" any:(var Str value))
                      ms_decode value
                      subject2 := value
                  cell
                    text (string files:i:datetime:date)
                  cell
                    text smart_name:from2
                  cell
                    small
                      while to2<>""
                        if not (to2 parse any:(var Str value) "," any:(var Str remain))
                          value := to2 ; remain := ""
                        text smart_name:value ; eol
                        to2 := remain
                  cell color (color hsl (shunt level>0 and not spam 0 60) 50 75)
                    if (mailboxes:p parse any:(var Str mailbox) "@" any:(var Str domain))
                      link (shunt subject2<>"" subject2 "no subject") "archive/"+domain+"/"+mailbox+"/"+(replace files:i:name ".mail" "")+"/" options "raw" no_extension
                    else
                      text (shunt subject2<>"" subject2 "no subject")
                  cell
                    text (string 100*rating "fixed 0")+"%"
      var Int total := spam_rejected+spam_unknown+spam_accepted+valid_rejected+valid_unknown+valid_accepted
      para
        text "Rejected spams: "
        font color (color hsl 120 100 50)
          text (string 100.0*spam_rejected/total "fixed 0")+"%"
        text " ("+string:spam_rejected+")" ; eol
        text "Unknown spams: "
        font color (color hsl 240 100 50)
          text (string 100.0*spam_unknown/total "fixed 0")+"%"
        text " ("+string:spam_unknown+")" ; eol
        text "Accepted spams: "
        font color (color hsl 60 100 50)
          text (string 100.0*spam_accepted/total "fixed 0")+"%"
        text" ("+string:spam_accepted+")" ; eol
      para
        text "Rejected valid mails: "
        font color (color hsl 0 100 50)
          text (string 100.0*valid_rejected/total "fixed 0")+"%"
        text " ("+string:valid_rejected+")" ; eol
        text "Unknown valid mails: "
        font color (color hsl 240 100 50)
          text (string 100.0*valid_unknown/total "fixed 0")+"%"
        text " ("+string:valid_unknown+")" ; eol
        text "Accepted valid mails: "
        font color (color hsl 120 100 50)
          text (string 100.0*valid_accepted/total "fixed 0")+"%"
        text " ("+string:valid_accepted+")" ; eol
    page button "remove spam filter"
      var Data:MailBox mb :> mailbox box
      file_delete (mb smart_path "")+"spam_ip.txt"
      file_delete (mb smart_path "")+"spam_word.txt"
      var Array:Str mailboxes paths
      each umb2 user:user:mailbox
        var Data:MailBox m2 :> mailbox umb2
        if exists:m2 and (keyof:m2=box or box="all")
          file_delete (m2 smart_path "")+"spam_filter.txt"
          file_delete (m2 smart_path "")+"spam_ip.txt"
          file_delete (m2 smart_path "")+"spam_word.txt"
      goto_backward
    para
      [A threshold of 50% will probably reject all spams, but is also likely to reject some valid mails.] ; eol
      [A threshold of 99% will reject very fiew valid mails.] ; eol
      [The optimal value depends on the kind of mails you receive and the tradeoff you select between accepting a fiew spams, or rejecting some valid mails.]


method page set_auto_answer_messages user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    title "Set the auto answer messages"
    table columns 2
      cell header [Mailbox] 
      cell header [Auto answer message] 
      each umb user:user:mailbox
        var Data:MailBox m :> mailbox umb
        cell
          text keyof:m
        cell
          text_input "" m:auto_answer columns 80 rows 5
    button "update"
      goto_backward    
      

#----------------------------------------------------------------------
# dispatch


function is_owner user mailbox -> owner
  arg Str user mailbox ; arg CBool owner
  each umb user:user:mailbox
    if umb=mailbox
      return true
  owner := false


method page mail path options
  arg_rw HtmlPage page ; arg Str path options
  implicit page
    requires "mail"
    if path="/"
      mail_list user_name
      para
        link "send a mail" "send" no_extension ; eol
        link "search in the archives" "search" no_extension ; eol
      para
        each umb user:user_name:mailbox
          var Data:MailBox m :> mailbox umb
          if (keyof:m parse any:(var Str box) "@" any:(var Str domain))
            var Array:FileInfo areas := file_list m:area_path standard+directories+relative
            if areas:size<>0
              [Areas for mailbox] ; fixed (text " "+keyof:m) ; eol
            for (var Int i) 0 areas:size-1
              var Str area := areas:i:name
              area := area 0 (area search "/" area:len)
              link neutral_decode:area "area/"+domain+"/"+box+"/"+area+"/"
              link http_decode:area "area/"+domain+"/"+box+"/"+area+"/"
              var Int n := (file_list m:area_path+areas:i:name standard) size
              if n>0
                fixed [  ] ; small (text string:n+" mail"+(shunt n>1 "s" ""))
              eol
      para
        link "edit your bookmarks" "bookmarks" no_extension ; eol
        link "create a new area" "create_area" no_extension
        fixed [ ] ; link "delete an area" "delete_area" no_extension ; eol
        link "set spams filter" "spam_filter" no_extension
        link "set auto answer messages" "auto_answer" no_extension
        each umb user:user_name:mailbox
          var Data:MailBox m :> mailbox umb
          if m:auto_answer<>""
            fixed [ ] ; highlight keyof:m
        eol 
        link "set spams filter" "spam_filter" no_extension ; eol
      spam_list user_name
    eif path="/send"
      mail_edit user_name
    eif path="/preview"
      mail_preview user_name
    eif path="/search"
      mail_search user_name
    eif path="/bookmarks"
      mail_bookmarks user_name
    eif path="/create_area"
      mail_create_area user_name
    eif path="/delete_area"
      mail_delete_area user_name
    eif path="/spam_filter"
      set_spam_filter user_name
    eif path="/auto_answer"
      set_auto_answer_messages user_name
    eif (path parse "/in/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
      var Data:MailBox b :> mailbox box+"@"+domain
      var Str filename := b:in_path+id+".mail"
      if part<>"" or options="html"
        send_mime_part filename neutral_decode:part options false
        send_mime_part filename http_decode:part options false
      else
        mail_display user_name b filename "RBMD" 4 options
    eif (path parse "/unknown/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
      var Data:MailBox b :> mailbox box+"@"+domain
      var Str filename := b:unknown_path+id+".mail"
      if part<>"" or options="html"
        send_mime_part filename http_decode:part options false
      else
        mail_display user_name b filename "RBMD" 4 options
    eif (path parse "/spam/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
      var Data:MailBox b :> mailbox box+"@"+domain
      var Str filename := b:spam_path+id+".mail"
      if part<>"" or options="html"
        send_mime_part filename neutral_decode:part options false
        send_mime_part filename http_decode:part options false
      else
        mail_display user_name b filename "RBMD" 4 options
    eif (path parse "/area/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str area) "/" any:(var Str remain)) and (is_owner user_name box+"@"+domain)
      var Data:MailBox b :> mailbox box+"@"+domain
      if (remain parse any:(var Str id) "/"  any:(var Str part))
        var Str filename := b:area_path+area+"/"+id+".mail"
        if part<>"" or options="html"
          send_mime_part filename neutral_decode:part options false
          send_mime_part filename http_decode:part options false
        else
          mail_display user_name b filename "RBMD" 5 options
      else
        title "'"+area+"' area"
        mail_list (var Data:MailBox no_box) b:area_path+area+"/" ""
        mail_list "mail" (var Data:MailBox no_box) b:area_path+area+"/" ""
    eif (path parse "/archive/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str month) "/" any:(var Str day) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
      var Data:MailBox b :> mailbox box+"@"+domain
      var Str filename := b:archive_path+month+"/"+day+"/"+id+".mail"
      if part<>"" or options="html"
        send_mime_part filename neutral_decode:part options false
        send_mime_part filename http_decode:part options false
      else
        mail_display user_name b filename "RB" 6 options


export '. mail'