cups-pdf PostProcessing script to get users from pGina
[safeq] / 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
10 my ($file, $local_user, $remote_user) = @ARGV;
11
12 my $job_id = $1 if ( $file =~ m/job_(\d+)/ );
13
14 die "can't find job_id in [$file]" unless $job_id;
15
16 my $c_file = sprintf "/var/spool/cups/c%05d", $job_id;
17
18 my $blob = read_file $c_file;
19
20 my (undef,$ip) = split(/job-originating-host-name\x00/, $blob, 2);
21 my $len = ord(substr($ip,0,1));
22 $ip = substr($ip,1,$len);
23
24 my $database = 'pGinaDB';
25 my $hostname = '10.60.4.9';
26 my $port     = 3306;
27 my $user     = 'pGina';
28 my $password = 'secret';
29
30 my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
31 my $dbh = DBI->connect($dsn, $user, $password);
32
33 my $sth = $dbh->prepare(qq{
34         select * from pGinaSession where ipaddress = ? and logoutstamp is null order by loginstamp desc
35 }) or die "prepare statement failed: $dbh->errstr()";
36 $sth->execute($ip) or die "execution failed: $dbh->errstr()";
37 if ( $sth->rows < 1 ) {
38         die "can't find IP for job $job_id";
39 } elsif ( $sth->rows > 1 ) {
40         warn "ERROR: found $sth->rows() rows for $job_id, usng first one\n";
41 }
42 my $row = $sth->fetchrow_hashref();
43 warn "## row = ",dump($row);
44
45 $sth->finish;
46
47 my $username = $row->{username} || die "no username in row = ",dump($row);
48
49 my $spool = '/var/spool/cups-pdf/';
50 mkdir "$spool/$username" if ( ! -e "$spool/$username" );
51 my $filename_only = $file;
52 $filename_only =~ s/^.*\///; # basename
53
54 rename $file, "$spool/$username/$filename_only";
55
56 exit 0;