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