git.rot13.org Git - safeq/blob - cups-pdf-find-owner.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5
   6 use Data::Dump qw(dump);
   7 use File::Slurp;
   8 use DBI;
   9 use IO::Socket::INET;
  10
  11 my $socket = IO::Socket::INET->new(
  12         LocalPort => 4001,
  13         LocalAddr => 'localhost',
  14         Proto => 'tcp',
  15         Listen => 5,
  16         Reuse => 1
  17 ) or die "ERROR: $!";
  18
  19 open(my $log, '>>', '/var/log/cups/find_owner_log');
  20 $SIG{__WARN__} = sub {
  21         print STDERR @_;
  22         print $log time(), " ", @_;
  23 };
  24
  25 warn "$0 waiting for client connection on port ", $socket->sockaddr, ":", $socket->sockport, "\n";
  26
  27 while(1) {
  28         our $client_socket = $socket->accept();
  29         my $line = <$client_socket>;
  30
  31         warn "<< [$line]";
  32
  33 #my ($file, $local_user, $remote_user) = @ARGV;
  34 my ($file, $local_user, $remote_user) = split(/\s/,$line,3);
  35
  36 my $job_id = $1 if ( $file =~ m/job_(\d+)/ );
  37
  38 die "can't find job_id in [$file]" unless $job_id;
  39
  40 my $c_file = sprintf "/var/spool/cups/c%05d", $job_id;
  41
  42 if ( ! -e $c_file ) {
  43         my $wait = 5; # max s wait for file to appear
  44         while ( $wait ) {
  45                 $0 = "find-owner #$job_id wait $wait s for $c_file";
  46                 sleep 1;
  47                 $wait--;
  48                 last if -e $c_file;
  49         }
  50 }
  51
  52 my $blob = read_file $c_file;
  53
  54 my (undef,$ip) = split(/job-originating-host-name\x00/, $blob, 2);
  55 my $len = ord(substr($ip,0,1));
  56 $ip = substr($ip,1,$len);
  57
  58 my $database = 'pGinaDB';
  59 my $hostname = '10.60.4.9';
  60 my $port     = 3306;
  61 my $user     = 'pGina';
  62 my $password = 'secret';
  63
  64 my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
  65 my $dbh = DBI->connect($dsn, $user, $password);
  66
  67 my $sth = $dbh->prepare(qq{
  68         select * from pGinaSession where ipaddress = ? and logoutstamp is null order by loginstamp desc
  69 }) or die "prepare statement failed: $dbh->errstr()";
  70 $sth->execute($ip) or die "execution failed: $dbh->errstr()";
  71 if ( $sth->rows < 1 ) {
  72         die "can't find IP for job $job_id";
  73 } elsif ( $sth->rows > 1 ) {
  74         warn "ERROR: found $sth->rows() rows for $job_id, usng first one\n";
  75 }
  76 my $row = $sth->fetchrow_hashref();
  77 warn "## row = ",dump($row);
  78
  79 $sth->finish;
  80
  81 my $username = $row->{username} || die "no username in row = ",dump($row);
  82 $username =~ s/\@ffzg.hr$//; # strip domain, same as pGina
  83
  84 my $spool = '/var/spool/cups-pdf/';
  85 mkdir "$spool/$username" if ( ! -e "$spool/$username" );
  86 my $filename_only = $file;
  87 $filename_only =~ s/^.*\///; # basename
  88
  89 my $to = "$spool/$username/$filename_only";
  90 rename $file, $to;
  91 warn "# $to";
  92 $0 = "find-owner #$job_id $username $filename_only"
  93
  94 } # while(1)
  95