git.rot13.org Git - safeq/blob - terminal-server.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6
   7 use IO::Socket::INET;
   8
   9 $| = 1;
  10
  11 my $socket = IO::Socket::INET->new(
  12         LocalPort => 4096,
  13         Proto => 'tcp',
  14         Listen => 5,
  15         Reuse => 1
  16 ) or die "ERROR: $!";
  17
  18 print "$0 waiting for client connection on port 4096\n";
  19
  20 my $prices = {
  21         A3 => 0.3, # FIXME
  22         A4 => 0.2,
  23         BW => 0.0, # just paper cost
  24         COLOR => 3.99, # FIXME
  25         DUPLEX => -0.05,
  26 };
  27
  28 while(1) {
  29         our $client_socket = $socket->accept();
  30
  31         sub client_send {
  32                 my $text = join('', @_);
  33                 warn ">> $text\n";
  34                 print $client_socket "$text\r\n";
  35         }
  36
  37         sub client_line {
  38                 my $line = <$client_socket>;
  39                 if ( defined $line ) {
  40                         $line =~ s/[\r\n]+$//;
  41                         warn "<< $line\n";
  42                 }
  43                 return $line;
  44         }
  45
  46         # get the host and port number of newly connected client.
  47         my $peer_address = $client_socket->peerhost();
  48         my $peer_port = $client_socket->peerport();
  49
  50         print "Connection from: $peer_address:$peer_port\n";
  51
  52         my $credit = 3.30;
  53         my $total_charged = 0.00;
  54         my $total_pages   = 0;
  55         sub credit {
  56                 my $v = $credit;
  57                 $v = $_[0] if defined $_[0];
  58                 return sprintf "%1.2f kn", $v;
  59         }
  60
  61         while ($client_socket->connected) {
  62
  63                 my $line = client_line;
  64
  65                 if ( $line =~ m/^\.SQ ([\d\.]+) (\S+)/ ) {
  66                         my ($version,$serial) = ($1,$2);
  67                         client_send  ".SQ OK";
  68                         #client_send  ".SQ FAILED message";
  69                 } elsif ( $line =~ m/^\.CFG/ ) {
  70                         client_send  ".CFG OK %s";
  71                 } elsif ( $line =~ m/\.SERVER LIST/ ) {
  72                         client_send  ".ERROR NO-ENTERPRISE";
  73                 } elsif ( $line =~ m/\.CARD (\S+)/ ) {
  74                         my ($rfid_sid) = $1;
  75                         client_send  ".CARD OK Ime Prezime (nobody\@example.com)";
  76                 } elsif ( $line =~ m/\.PIN (\S+)/ ) {
  77                         my ($pin) = $1;
  78                         client_send  ".PIN OK Ime Pinzime (nobody\@example.com)";
  79                 } elsif ( $line =~ m/\.ACTION$/ ) {
  80                         # CMENUS0 - no printer
  81                         client_send  ".ACTION CMENUS68"; # FIXME can be CMENUS2
  82
  83                 } elsif ( $line =~ m/\.ACTION COPY/ ) {
  84                         client_send  ".ACTION COPY";    # safeq sends this twice
  85                         client_send  ".COPY Mozete kopirati |".credit;
  86                         client_send  ".NOP";
  87                         client_send  ".CREDIT ".credit;
  88                 } elsif ( $line =~ m/\.COPY (.+)/ ) {
  89                         # FIXME
  90                         my $charge = 0;
  91                         foreach ( split(/,/,$1) ) {
  92                                 die "can't find [$_] in prices=",dump($prices) unless exists $prices->{$_};
  93                                 $charge += $prices->{$_};
  94                         }
  95                         warn "CHARGE: $charge\n";
  96                         $credit        -= $charge;
  97                         $total_charged += $charge;
  98                         $total_pages++;
  99                         client_send ".CREDIT ".credit;
 100                         client_send ".COPY 1"; # I verified that you are allowed to copy 1 page?
 101                         client_send ".NOP";
 102
 103                 } elsif ( $line =~ m/\.ACTION LIST/ ) {
 104                         # FIXME
 105
 106                 } elsif ( $line =~ m/\.ACTION PRINT ALL/ ) {
 107                         # FIXME
 108
 109                 } elsif ( $line =~ m/^\.NOP/ ) {
 110                         # XXX it's important to sleep, before sending response or
 111                         # interface on terminal device will be unresponsive
 112                         sleep 1;
 113                         client_send  ".NOP";
 114                 } elsif ( $line =~ m/^\.END/ ) {
 115                         client_send  ".DONE BLK WAIT";
 116                         client_send  ".NOP";
 117                         my $nop = client_line;
 118                         client_send ".DONE $total_pages ".credit($total_charged);
 119                         warn "expected NOP got: $nop" unless $nop =~ m/NOP/;
 120                         my $null = client_line;
 121                         $client_socket->close;
 122                 } else {
 123                         warn "UNKNOWN: ",dump($line);
 124                         print "Response>";
 125                         my $r = <STDIN>;
 126                         chomp $r;
 127                         client_send $r;
 128                 }
 129         }
 130         warn "# return to accept";
 131 }
 132
 133 $socket->close();
 134
 135