Patch title: Release 92 bulk changes
Abstract:
File: /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

abstract
  [This is Pliant LPR server implementation (RFC 1179)] ; eol
  link "LPRng extension" "http://web.mit.edu/source/third/lprng/doc/LPRng-HOWTO-18.html"

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"

(gvar TraceSlot lpr_trace) configure "LPR server"

function tcp_port -> port
  arg Int port
  if not (this_computer:env:"pliant":"lpr":"port" parse port)
    port := 515

type LprServer
  tcp_server_fields "LPR" 515
  tcp_server_fields "LPR" constant:tcp_port
TcpServer maybe LprServer


method server start_checkup -> status
  arg_rw LprServer server ; arg Status status
  lpr_init
  lpr_spool
  status := success

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":queue pmap "" LprQueue
    if printer:export<>"" and ((lpr safe_query "remote_ip_address") is_inside_ip_domain printer:export)
      var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
      var Data:LprJob job :> lpr_open queue "" (var Stream data)
      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) # control
            var Str temp := file_temporary
            (var Stream s) open temp out+safe
            var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
            raw_copy lpr s size size
            s close
            lpr raw_read addressof:(var uInt8 ack) 1
            var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
            lpr_embedded_convert temp job
            file_delete temp
          eif op=3 and (cmd parse (var Intn total) _ any) # data
            var uInt8 ack := 0 ; lpr raw_write addressof:ack 1
            if total>0
              var Intn remain := total
              while remain>0 and { var Int step := raw_copy lpr data 1 (cast (shunt remain<2^24 remain 2^24) Int) ; step>0 }
                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 queued"
      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 to send print jobs from "+(lpr safe_query "remote_ip_address") "No such print queue")
  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