/pliant/protocol/lpr/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/context.pli" 
 18  module "/pliant/language/stream.pli" 
 19  module "/pliant/language/stream/openmode.pli" 
 20  module "/pliant/language/stream/multi.pli" 
 21  module "/pliant/language/stream/filesystembase.pli" 
 22  module "/pliant/admin/file.pli" 
 23   
 24  constant lpr_timeout 900 # default timeout is 15 minutes 
 25   
 26  (gvar TraceSlot lpr_trace) configure "LPR client" 
 27   
 28   
 29  type LprFileSystem 
 30    void 
 31  FileSystem maybe LprFileSystem 
 32   
 33  type LprStreamDriver 
 34    field Link:Stream tcp 
 35    field CBool direct nosize ; field Intn remain 
 36    field Str filename 
 37    field Link:Stream temp 
 38    field Str server id 
 39  StreamDriver maybe LprStreamDriver 
 40   
 41  method lpr write buf mini maxi -> written 
 42    arg_rw LprStreamDriver lpr ; arg Address buf ; arg Int mini maxi written 
 43    if lpr:direct 
 44      if lpr:nosize 
 45        written := maxi 
 46      eif lpr:remain>=maxi 
 47        written := maxi 
 48      eif lpr:remain>=mini 
 49        written := lpr remain 
 50      else 
 51        written := 0 
 52      lpr:tcp raw_write buf written 
 53      if lpr:tcp=failure 
 54        written := 0 
 55      lpr remain -= written 
 56    eif (exists lpr:temp) 
 57      lpr:temp raw_write buf maxi 
 58      written := shunt lpr:temp=success maxi 0 
 59    else 
 60      written := 0 
 61   
 62  method lpr flush level -> status 
 63    arg_rw LprStreamDriver lpr ; arg Int level ; arg Status status 
 64    if lpr:direct 
 65      lpr:tcp flush level 
 66    eif (exists lpr:temp) 
 67      lpr:temp flush level 
 68    status := success 
 69   
 70  method lpr query command stream answer -> status 
 71    oarg_rw LprStreamDriver lpr ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status 
 72    if command="seek" and not lpr:direct 
 73      stream flush anytime 
 74      status := lpr:temp:stream_driver query command lpr:temp answer 
 75    else 
 76      status := failure 
 77   
 78  method lpr configure command stream -> status 
 79    arg_rw LprStreamDriver lpr ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 80    if (command parse word:"seek" (var Intn pos)) and not lpr:direct 
 81      stream flush anytime 
 82      status := lpr:temp:stream_driver configure command lpr:temp 
 83    else 
 84      status := failure 
 85   
 86  method lpr close -> status 
 87    arg_rw LprStreamDriver lpr ; arg ExtendedStatus status 
 88    var Pointer:Stream tcp :> lpr tcp 
 89    if lpr:direct 
 90      if not lpr:nosize and lpr:remain<>0 
 91        return failure:"Too fiew bytes written" 
 92    eif (exists lpr:temp) 
 93      lpr:temp close 
 94      var FileInfo info := file_query lpr:filename standard 
 95      var uInt8 cmd8 := 3 ; tcp raw_write addressof:cmd8 1 
 96      tcp writeline (string info:size)+" dfa"+lpr:id+computer_name 
 97      tcp raw_read addressof:(var uInt8 ack) 1 
 98      if ack<>0 
 99        file_delete lpr:filename 
 100        lpr_trace trace "'" lpr:server "' does not want to receive print data file" 
 101        return (failure "'"+lpr:server+"' does not want to receive print data file") 
 102      (var Stream s) open lpr:filename in 
 103      while (raw_copy s tcp 1 2^24)>0 
 104        void 
 105      s close 
 106      file_delete lpr:filename 
 107    if not lpr:nosize 
 108      var uInt8 cmd8 := 0 ; tcp raw_write addressof:cmd8 1 
 109      tcp raw_read addressof:(var uInt8 ack) 1 
 110      if ack<>0 
 111        lpr_trace trace "server failed to receive data file (" (cast ack Int) ")" 
 112        return (failure "server failed to receive data file ("+string:(cast ack Int)+")") 
 113    status := tcp close 
 114   
 115  gvar Int counter := -1 
 116   
 117  method fs open name options flags stream support -> status 
 118    arg_rw LprFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 119    if (name eparse "//" any:(var Str server) "/" any:(var Str queue) "/" any:(var Str file)) 
 120      void 
 121    eif (name eparse "//" any:(var Str server) "/" any:(var Str queue)) 
 122      file := "" 
 123    else 
 124      return failure:"Incorrect name" 
 125    var Int port 
 126    if (server parse any:(var Str remain) ":" port) 
 127      server := remain 
 128    else 
 129      port := 515 
 130    if (flags .and. in_out)<>out 
 131      return failure:"The only supported mode for LPR client is 'out'" 
 132    var Intn size := options option "file_size" Intn 
 133    var Link:Stream tcp :> new Stream 
 134    var Int lap := 1 
 135    part select_id 
 136      tcp open "tcp://"+server+"/client/"+string:port in+out+safe 
 137      if tcp=failure 
 138        lpr_trace trace "Failed to connect to '" server "' LPR port" 
 139        return (failure "Failed to connect to '"+server+"' LPR port") 
 140      tcp configure "timeout "+string:(options option "timeout" Int lpr_timeout) 
 141      var uInt8 cmd8 := 2 ; tcp raw_write addressof:cmd8 1 
 142      tcp writeline (shunt queue<>"" queue "lp") 
 143      tcp raw_read addressof:(var uInt8 ack) 1 
 144      if ack<>0 
 145        lpr_trace trace "'" server "' does not want to receive a print job" 
 146        return (failure "'"+server+"' does not want to receive a print job") 
 147      counter := (counter+1)%1000 
 148      var Str id := right string:counter 3 "0" 
 149      var Str control := "H"+computer_name+"[lf]P"+(options option "user" Str "Pliant")+"[lf]"+(options option "lpr_format" Str "l")+"dfa"+id+computer_name+"[lf]Udfa"+id+computer_name+"[lf]J"+(options option "title" Str)+(shunt file<>"" "[lf]N"+file "")+"[lf]" 
 150      var uInt8 cmd8 := 2 ; tcp raw_write addressof:cmd8 1 
 151      tcp writeline (string control:len)+" cfa"+id+computer_name 
 152      tcp raw_read addressof:(var uInt8 ack) 1 
 153      if ack<>0 and lap<1000 
 154        lap += 1 
 155        restart select_id 
 156      if ack<>0 
 157        lpr_trace trace "'" server "' does not want to receive print control file" 
 158        return (failure "'"+server+"' does not want to receive print control file") 
 159      tcp writechars control 
 160      var uInt8 cmd8 := 0 ; tcp raw_write addressof:cmd8 1 
 161      tcp raw_read addressof:(var uInt8 ack) 1 
 162      if ack<>0 
 163        lpr_trace trace "'" server "' failed to receive print control file (" (cast ack Int) ")" 
 164        return (failure "'"+server+"' failed to receive print control file ("+string:(cast ack Int)+")") 
 165      var Link:LprStreamDriver lpr :> new LprStreamDriver 
 166      lpr tcp :> tcp 
 167      if (size<>undefined or (options option "lprng")) and (flags .and. seek)=0 
 168        lpr direct := true 
 169        lpr remain := size 
 170        lpr nosize := size=undefined 
 171        var uInt8 cmd8 := 3 ; tcp raw_write addressof:cmd8 1 
 172        tcp writeline string:(shunt size=undefined 0 size)+" dfa"+id+computer_name 
 173        tcp raw_read addressof:(var uInt8 ack) 1 
 174        if ack<>0 and lap<1000 
 175          var uInt8 cmd8 := 1 ; tcp raw_write addressof:cmd8 1 
 176          tcp writeline "" 
 177          tcp raw_read addressof:(var uInt8 ack) 1 
 178          if ack=0 
 179            lap += 1 
 180            restart select_id 
 181        if ack<>0 
 182          lpr_trace trace "'" server "' does not want to receive print data file" 
 183          return (failure "'"+server+"' does not want to receive print data file") 
 184      else 
 185        lpr direct := false 
 186        lpr nosize := false 
 187        lpr filename := file_temporary 
 188        lpr temp :> new Stream 
 189        lpr:temp open lpr:filename out+(flags .and. safe) 
 190        lpr server := server 
 191        lpr id := id 
 192    stream stream_driver :> lpr 
 193    lpr_trace trace "print job queued on '"+server+"' in queue '"+queue+"'" 
 194    status := success 
 195       
 196  gvar LprFileSystem lpr_file_system 
 197  pliant_multi_file_system mount "lpr:" "" lpr_file_system 
 198  pliant_multi_file_system mount "lprng:" "" "lprng" lpr_file_system