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

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