/pliant/protocol/smtp/mime.pli
 
 1  module "/pliant/language/unsafe.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/util/encoding/base64.pli" 
 4  module "/pliant/util/encoding/qp.pli" 
 5   
 6   
 7  function ms_decode l 
 8    arg_rw Str l 
 9    if (eparse any:(var Str head) "=?" any:(var Str charset) "?" any:(var Str enc) "?" any:(var Str value) "?=" any:(var Str tail)) 
 10      if lower:enc="q" 
 11        ms_decode tail 
 12        := head+qp_decode:value+tail 
 13      eif lower:enc="b" 
 14        ms_decode tail 
 15        := head+base64_decode:value+tail 
 16   
 17   
 18  type MimeStream 
 19    field Pointer:Stream stream 
 20    field Str name 
 21    field Str mime encoding 
 22    field CBool embedded <- false 
 23    field CBool html <- false 
 24    field CBool spam <- false 
 25    field Int encoding_model <- 0 
 26    field List:Str boundaries 
 27    field Str ready 
 28   
 29  method ms multipart -> c 
 30    arg MimeStream ms ; arg CBool c 
 31    := (exists ms:boundaries:first) or ms:embedded 
 32   
 33  method ms bind s reset 
 34    arg_rw MimeStream ms ; arg_rw Stream s ; arg CBool reset 
 35    ms stream :> s 
 36    ms name := "" 
 37    ms mime := "" 
 38    ms embedded := false 
 39    ms html := false 
 40    ms encoding_model := 0 
 41    ms ready := "" 
 42    if reset 
 43      ms boundaries := var List:Str empty_list 
 44      ms spam := false 
 45   
 46  method ms header_line l -> c 
 47    arg_rw MimeStream ms ; arg_w Str l ; arg CBool c 
 48    := ms:stream readline 
 49    if l="" 
 50      return false 
 51    while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" } 
 52      += ms:stream readline 
 53    if (parse acword:"content-type" ":" any:(var Str value) ";" any) 
 54      ms mime := value 
 55    eif (parse acword:"content-type" ":" any:(var Str value)) 
 56      ms mime := value 
 57    if (parse acword:"content-transfer-encoding" ":" any:(var Str value) ";" any) 
 58      ms encoding := value 
 59    eif (parse acword:"content-transfer-encoding" ":" any:(var Str value)) 
 60      ms encoding := value 
 61    if (parse acword:"content-type" ":" acword:"message" any) 
 62      ms embedded := true 
 63    if (parse acword:"content-type" ":" acword:"text" "/" word:"html" any) 
 64      ms html := true 
 65    if (parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any) 
 66      ms boundaries += value 
 67    eif (parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value)) 
 68      ms boundaries += value 
 69    if (parse acword:"content-transfer-encoding" ":" any acword:"8bit" any) 
 70      ms encoding_model := 0 
 71    eif (parse acword:"content-transfer-encoding" ":" any acword:"base64" any) 
 72      ms encoding_model := 1 
 73    eif (parse acword:"content-transfer-encoding" ":" any acword:"quoted-printable" any) 
 74      ms encoding_model := 2 
 75    eif (parse acword:"content-transfer-encoding" ":" any) 
 76      ms encoding_model := undefined 
 77    if l="spam" 
 78      ms spam := true 
 79    # Novell unstandard encoding_model 
 80    if (parse acword:"content-disposition" ":" any acword:"filename" "=" "[dq]" any:(var Str value) "[dq]" any) 
 81      ms_decode value 
 82      ms name := value 
 83    eif (l+";" parse acword:"content-disposition" ":" any acword:"filename" "=" any:(var Str value) ";" any) 
 84      ms name := value 
 85    if (parse acword:"content-type" ":" any acword:"name" "=" "[dq]" any:(var Str value) "[dq]" any) 
 86      ms_decode value # cope with crazy Microsoft encoding_model 
 87      ms name := value 
 88    eif (l+";" parse acword:"content-type" ":" any acword:"name" "=" any:(var Str value) ";" any) 
 89      ms name := value 
 90    := true 
 91   
 92   
 93  method ms body_line l -> c 
 94    arg_rw MimeStream ms ; arg_w Str l ; arg CBool c 
 95    if ms:ready:len>0 
 96      := ms ready 
 97      ms ready := "" 
 98      return true 
 99    if ms:stream:atend 
 100      return false 
 101    := ms:stream readline 
 102    if (0 2)="--" 
 103      var Pointer:Str :> ms:boundaries first 
 104      while exists:b 
 105        if l="--"+or l="--"+b+"--" 
 106          return false 
 107        :> ms:boundaries next b 
 108    if ms:encoding_model=# base64 
 109      := base64_decode l 
 110    eif ms:encoding_model=# quoted printable 
 111      if l:len>and (l:len-1)="=" 
 112        := qp_decode (l:len-1) 
 113      else 
 114        := qp_decode:l+"[lf]" 
 115    else 
 116      += "[lf]" 
 117    if ms:embedded   
 118      while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" } 
 119        += ms:stream readline 
 120      if (parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any) 
 121        ms boundaries += value 
 122      eif (parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value)) 
 123        ms boundaries += value 
 124      if l="" 
 125        ms embedded := false 
 126    := true 
 127   
 128  method ms unread l 
 129    arg_rw MimeStream ms ; arg Str l 
 130    ms ready := l 
 131   
 132  export ms_decode 
 133  export MimeStream '. bind' 
 134  export '. name' '. mime' '. encoding' '. encoding_model' '. multipart' '. html' '. spam' 
 135  export '. header_line' '. body_line' '. unread' 
 136   
 137   
 138   
 139