Patch title: Release 81 bulk changes
Abstract:
File: /pliant/protocol/lpr/server.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

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"

type LprServer
  tcp_server_fields "LPR" 515
TcpServer maybe LprServer


method server start_checkup -> status
  arg_rw LprServer server ; arg Status status
  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 Str job := generate_id
      var Str control := file_temporary
      var Str data := file_temporary
      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
            file_delete "data:/pliant/spool/"+queue+"/"+job+".lpr"
            file_delete "data:/pliant/spool/"+queue+"/"+job+".pdb"
            leave receive_job
          eif op=2 and (cmd parse (var Int size) _ any) # control
            (var Stream s) open control 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
          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 Stream s) open data out+safe
              var Intn remain := total
              while remain>0 and { var Int step := raw_copy lpr s 1 (cast (shunt remain<2^24 remain 2^24) Int) ; step>0 }
                remain -= step
              lpr raw_read addressof:(var uInt8 ack) 1
              ack := shunt remain=0 and s:close=success 0 1
            eif printer:once and (lpr_printer_sem nowait_request printer:printer)
              (var Stream s) open printer:device printer:options out+safe
              lpr_device_init printer:device
              (var Stream s) open printer:device printer:options+" timeout "+(string printer:timeout) out+safe
              while (raw_copy lpr s 1 2^24)>0
                void
              lpr_printer_sem release printer:printer
            else
              (var Stream s) open data out+safe
              while (raw_copy lpr s 1 2^24)>0
                void
            lpr raw_write addressof:ack 1
      if (file_query data standard)=success
        lpr_embedded_convert control "data:/pliant/spool/"+queue+"/"+job+".pdb" (lpr safe_query "remote_ip_address") lpr_file_format:data
        if (file_move data "data:/pliant/spool/"+queue+"/"+job+".lpr")=success
          void
      file_delete control
    else
      var uInt8 ack := 1 ; lpr raw_write addressof:ack 1
      log trace "answer" (shunt exists:lpr "Not allowed to send print jobs from "+(lpr safe_query "remote_ip_address") "No such print queue")
  eif (op=3 or op=4)
    var Array:FileInfo files := file_list "data:/pliant/spool/"+queue+"/" standard
    for (var Int i) 0 files:size-1
      lpr writeline files:i:stripped_name
  eif op=5
    void # remove job
  

define_tcp_server LprServer lpr_server
export lpr_server