Patch title: Release 94 bulk changes
Abstract:
File: /pliant/protocol/lpr/server.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
# It's released under GNU General Public License version 2


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
# It's released under GNU General Public License version 2


module "/pliant/install/minimal.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/data/id.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/schedule/namedsem.pli"
submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/fullpliant/this_computer.pli"
module "database.pli"
module "embedded.pli"
module "spool.pli"
module "device.pli"


method server service lpr
  arg_rw LprServer server ; arg_rw Stream lpr
  (var TraceSession log) bind lpr_trace
  lpr raw_read addressof:(var uInt8 op) 1
  var Str cmd := lpr readline
  log trace "command" string:(cast op Int)+" "+cmd
  if not (cmd parse any:(var Str queue) _ any:(var Str list)
    queue := cmd ; list := ""
  if queue="lp"
    each p this_computer:env:"printer"
      if p:"default"="yes"
        queue := keyof p
  if op=2
    var Data:LprQueue printer :> this_computer:env:"printer"
    if printer:export<>"" and ((lpr safe_query "remote_ip_ad
      var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
      var Data:LprJob job :> lpr_open queue "" (var Stream d
      job ip := lpr safe_query "remote_ip_address"
      var CBool ok := false
      part receive_job
        while not lpr:atend
          lpr raw_read addressof:(var uInt8 op) 1
          var Str cmd := lpr readline
          log trace "job" string:(cast op Int)+" "+cmd
          if op=1
            ok := false
            leave receive_job
          eif op=2 and (cmd parse (var Int size) _ any) # co
            var Str temp := file_temporary
            (var Stream s) open temp out+safe
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            raw_copy lpr s size size
            s close
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/data/id.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/schedule/namedsem.pli"
submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/fullpliant/this_computer.pli"
module "database.pli"
module "embedded.pli"
module "spool.pli"
module "device.pli"


method server service lpr
  arg_rw LprServer server ; arg_rw Stream lpr
  (var TraceSession log) bind lpr_trace
  lpr raw_read addressof:(var uInt8 op) 1
  var Str cmd := lpr readline
  log trace "command" string:(cast op Int)+" "+cmd
  if not (cmd parse any:(var Str queue) _ any:(var Str list)
    queue := cmd ; list := ""
  if queue="lp"
    each p this_computer:env:"printer"
      if p:"default"="yes"
        queue := keyof p
  if op=2
    var Data:LprQueue printer :> this_computer:env:"printer"
    if printer:export<>"" and ((lpr safe_query "remote_ip_ad
      var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
      var Data:LprJob job :> lpr_open queue "" (var Stream d
      job ip := lpr safe_query "remote_ip_address"
      var CBool ok := false
      part receive_job
        while not lpr:atend
          lpr raw_read addressof:(var uInt8 op) 1
          var Str cmd := lpr readline
          log trace "job" string:(cast op Int)+" "+cmd
          if op=1
            ok := false
            leave receive_job
          eif op=2 and (cmd parse (var Int size) _ any) # co
            var Str temp := file_temporary
            (var Stream s) open temp out+safe
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            raw_copy lpr s size size
            s close
            (var Stream s) open temp in+safe
            while not s:atend
              var Str l := s readline
              log trace "control" l
            s close
            lpr raw_read addressof:(var uInt8 ack) 1
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            lpr_embedded_convert temp job
            file_delete temp
          eif op=3 and (cmd parse (var Intn total) _ any) # 
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            if total>0
              var Intn remain := total
              while remain>0 and { var Int step := raw_copy 
                remain -= step
              lpr raw_read addressof:(var uInt8 ack) 1
              if remain<>0
                ack := 1
            else
              while (raw_copy lpr data 1 2^24)>0
                void
            lpr raw_write addressof:ack 1
            ok := ack=0
      if (lpr_close job data)=failure
        ok := false
      if ok
        log trace "success" "Job '"+keyof:job+"' is now queu
      else
        lpr_cancel job data
        log trace "failure" "Job datas not properly received
    else
      var uInt8 ack := 1 ; lpr raw_write addressof:ack 1
      log trace "answer" (shunt exists:printer "Not allowed 
  eif (op=3 or op=4)
    each job lpr_database:data:job filter job:queue=queue
      lpr writeline keyof:job
  eif op=5
    void # remove job
  

define_tcp_server LprServer lpr_server
export lpr_server
            lpr raw_read addressof:(var uInt8 ack) 1
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            lpr_embedded_convert temp job
            file_delete temp
          eif op=3 and (cmd parse (var Intn total) _ any) # 
            var uInt8 ack := 0 ; lpr raw_write addressof:ack
            if total>0
              var Intn remain := total
              while remain>0 and { var Int step := raw_copy 
                remain -= step
              lpr raw_read addressof:(var uInt8 ack) 1
              if remain<>0
                ack := 1
            else
              while (raw_copy lpr data 1 2^24)>0
                void
            lpr raw_write addressof:ack 1
            ok := ack=0
      if (lpr_close job data)=failure
        ok := false
      if ok
        log trace "success" "Job '"+keyof:job+"' is now queu
      else
        lpr_cancel job data
        log trace "failure" "Job datas not properly received
    else
      var uInt8 ack := 1 ; lpr raw_write addressof:ack 1
      log trace "answer" (shunt exists:printer "Not allowed 
  eif (op=3 or op=4)
    each job lpr_database:data:job filter job:queue=queue
      lpr writeline keyof:job
  eif op=5
    void # remove job
  

define_tcp_server LprServer lpr_server
export lpr_server