/pliant/protocol/pop3/client.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "/pliant/language/unsafe.pli" 
 17  module "/pliant/language/stream.pli" 
 18  module "/pliant/language/stream/multi.pli" 
 19  module "/pliant/language/stream/filesystembase.pli" 
 20  module "/pliant/language/stream/openmode.pli" 
 21  module "/pliant/admin/md5.pli" 
 22   
 23  (gvar TraceSlot pop3_trace) configure "POP3 client" 
 24   
 25   
 26  function command s cmd timestamp log -> status 
 27    arg_rw Stream s ; arg Str cmd ; arg_w Str timestamp ; arg_rw TraceSession log ; arg Status status 
 28    if cmd<>"" 
 29      s writeline cmd 
 30      log trace "query " cmd 
 31    var Str l := s readline   
 32    log trace "answer " cmd 
 33    if s=failure 
 34      return failure 
 35    status := shunt (upper:l parse "+OK" any) success failure 
 36    if (l parse any "<" any:(var Str stamp) ">") 
 37      timestamp := "<"+stamp+">" 
 38    else 
 39      timestamp := "" 
 40       
 41  function command s cmd log -> status 
 42    arg_rw Stream s ; arg Str cmd ; arg_rw TraceSession log ; arg Status status 
 43    status := command s cmd (var Str timestamp) log 
 44    
 45   
 46  type Pop3FileSystem 
 47    void 
 48  FileSystem maybe Pop3FileSystem 
 49   
 50  type Pop3StreamDriver 
 51    field Link:Stream tcp 
 52    field Link:TraceSession log 
 53    field Str buffer 
 54    field CBool atend 
 55    field CBool remove 
 56  StreamDriver maybe Pop3StreamDriver 
 57   
 58  method pop3 read buf mini maxi -> red 
 59    arg_rw Pop3StreamDriver pop3 ; arg Address buf ; arg Int mini maxi red 
 60    if pop3:tcp:stream_read_cur<>pop3:tcp:stream_read_stop 
 61      red := min (cast pop3:tcp:stream_read_stop Int).-.(cast pop3:tcp:stream_read_cur Int) maxi 
 62      memory_copy pop3:tcp:stream_read_cur buf red 
 63      pop3:tcp:stream_read_cur := pop3:tcp:stream_read_cur translate Byte red 
 64    else 
 65      red := pop3:tcp:stream_driver read buf mini maxi 
 66   
 67  if false 
 68    method pop3 close -> status 
 69      arg_rw Pop3StreamDriver pop3 ; arg ExtendedStatus status 
 70      pop3:tcp flush end 
 71      status := shunt pop3:tcp=success success failure 
 72      pop3:tcp close 
 73   
 74  method fs open name options flags stream support -> status 
 75    arg_rw Pop3FileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 76    if (flags .and. in_out)<>in 
 77      return failure 
 78    if (name eparse "//" any:(var Str server) "/" any:(var Str user) "/" any:(var Str password)) 
 79      void 
 80    eif (name eparse "//" any:(var Str server)) 
 81      user := "" ; password := "" 
 82    else 
 83      return failure 
 84    var Int port := options option "port" Int 
 85    if port=undefined 
 86      port := 110 
 87    if (options option "user" Str)<>"" 
 88      user := options option "user" Str 
 89    if (options option "password" Str)<>"" 
 90      password := options option "password" Str 
 91    var Link:Stream tcp :> new Stream 
 92    tcp open "tcp://"+server+"/client/110" in+out+safe 
 93    if tcp=failure 
 94      pop3_trace trace "Failed to connect to " tcp:name 
 95      return failure 
 96    var Link:TraceSession log :> new TraceSession 
 97    log bind pop3_trace 
 98    if (command tcp "" (var Str timestamp) log)=failure 
 99      return failure 
 100    part auth 
 101      if (timestamp eparse any "<" any:(var Str seed) ">") 
 102        if (command tcp "APOP "+user+" "+lower:(string_md5_hexa_signature "<"+seed+">"+password) log)=success 
 103          leave auth 
 104      tcp open "tcp://"+server+"/client/110" in+out+safe 
 105      if tcp=failure or (command tcp "" (var Str timestamp) log)=failure 
 106        return failure 
 107      if (command tcp "USER "+user log)=failure 
 108        return failure 
 109      if (command tcp "PASS "+password log)=failure 
 110        return failure 
 111    if (command tcp "RETR 1" log)=failure 
 112      return failure 
 113    var Link:Pop3StreamDriver drv :> new Pop3StreamDriver 
 114    stream stream_driver :> drv 
 115    drv tcp :> tcp 
 116    drv log :> log 
 117    drv atend := false 
 118    drv remove := true 
 119    status := success 
 120   
 121   
 122  method drv read buf mini maxi -> red 
 123    arg_rw Pop3StreamDriver drv ; arg Address buf ; arg Int mini maxi red 
 124    red := 0 
 125    while red<mini 
 126      if drv:buffer:len<>0 
 127        var Int step := min drv:buffer:len maxi 
 128        memory_copy drv:buffer:characters (buf translate Byte red) step 
 129        drv buffer := drv:buffer step drv:buffer:len 
 130        red += step 
 131      if drv:atend or drv:tcp:atend 
 132        return 
 133      var Str l := drv:tcp readline 
 134      if l="." 
 135        drv atend := true 
 136        return 
 137      if (l 0 2)=".." 
 138        l := l 1 l:len 
 139      if red+l:len+1<=maxi 
 140        memory_copy l:characters (buf translate Byte red) l:len 
 141        red += l:len 
 142        memory_copy "[lf]":characters (buf translate Byte red) 1 
 143        red += 1 
 144      else 
 145        drv buffer += l+"[lf]" 
 146   
 147   
 148  method drv close -> status 
 149    arg_rw Pop3StreamDriver drv ; arg Status status 
 150    if not drv:atend 
 151      while not drv:tcp:atend and drv:tcp:readline<>"." 
 152        void 
 153    if drv:remove 
 154      if (command drv:tcp "DELE 1" drv:log)=failure 
 155        return failure 
 156    if (command drv:tcp "QUIT" drv:log)=failure 
 157      return failure 
 158    return success 
 159   
 160   
 161  method drv configure command stream -> status 
 162    arg_rw Pop3StreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 163    if command="keep" 
 164      drv remove := false 
 165      status :=success 
 166    else 
 167      status := failure 
 168   
 169  gvar Pop3FileSystem pop3_file_system 
 170  pliant_multi_file_system mount "pop3:" "" pop3_file_system