ps_fcgi.pl (3351B)
1 #!/usr/bin/env perl -T 2 use strict; 3 use warnings; 4 5 # all dependencies explicitly listed 6 use Config::Grammar; 7 use DBD::SQLite; 8 use Encode; 9 use FCGI; 10 use Getopt::Std; 11 use Template; 12 use Template::Context; 13 use Template::Filters; 14 use Template::Iterator; 15 use Template::Parser; 16 use Template::Plugins; 17 use Template::Stash::XS; 18 use PriceSloth; 19 use Unix::Syslog qw(:macros :subs); 20 use URI::Escape; 21 22 23 my %args; 24 getopts("v", \%args); 25 26 # fork into background unless verbose 27 unless ($args{v}) { 28 if (fork()) { 29 exit(); 30 } 31 } 32 33 my $cfg = get_config(); 34 my %http_cfg = %{$cfg->{http}}; 35 36 openlog("ps_fcgi", LOG_PID, LOG_DAEMON); 37 38 if (-e $http_cfg{socket}) { 39 my $msg = "error: socket $http_cfg{socket} exists\n"; 40 print "$msg\n" if ($args{v}); 41 syslog(LOG_ERR, $msg); 42 exit; 43 } 44 45 my $socket = FCGI::OpenSocket($http_cfg{socket}, 1024); 46 my $request = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR, \%ENV, $socket, 47 FCGI::FAIL_ACCEPT_ON_INTR); 48 49 # XXX: sqlite_open_flags => DBD::SQLite::OPEN_READONLY 50 my $dbh = get_dbh($cfg->{general}{db_dir}, $args{v}); 51 my $sql = qq{select distinct manufacturer, part_num from prices where 52 manufacturer like ? or part_num like ?}; 53 my $srch_sth = $dbh->prepare($sql); 54 55 my ($user, $group) = ($http_cfg{uid}, $http_cfg{gid}); 56 my $uid = getpwnam($user) or die "error: user $user does not exist\n"; 57 my $gid = getgrnam($group) or die "error: group $group does not exist\n"; 58 chown $uid, $gid, $http_cfg{socket} or die "error: chown $uid:$gid: $!"; 59 60 if (fork()) { 61 # parent 62 $0 = "ps_fcgi [priv]"; 63 64 # child should catch sigint and exit nicely, then we exit nicely here 65 $SIG{INT} = "IGNORE"; 66 67 print "info: parent: alive\n" if ($args{v}); 68 syslog(LOG_INFO, "parent: alive"); 69 70 wait(); 71 72 print "info: parent: cleaning up\n" if ($args{v}); 73 syslog(LOG_INFO, "parent: shutdown"); 74 75 $dbh->disconnect(); 76 FCGI::CloseSocket($socket); 77 unlink($http_cfg{socket}) or warn "unlink $http_cfg{socket} failed: $!"; 78 closelog(); 79 80 exit 0; 81 } 82 83 # child 84 $0 = "ps_fcgi sloth"; 85 86 print "info: child: chroot $http_cfg{chroot}\n" if ($args{v}); 87 chroot $http_cfg{chroot} or die "chroot $http_cfg{chroot} failed: $!\n"; 88 chdir "/" or die "cd / failed: $!\n" ; 89 90 $( = $) = "$gid $gid"; 91 $< = $> = $uid; 92 print "info: child: uid:gid appears to be $<:$(\n" if ($args{v}); 93 94 # catch ctrl-c and default kill(1) signal 95 $SIG{INT} = \&child_sig_handler; 96 $SIG{TERM} = \&child_sig_handler; 97 98 # remove chroot dir from beginning of htdocs dir 99 my $chroot_tt_dir = "$http_cfg{htdocs}/tt"; 100 $chroot_tt_dir =~ s/$http_cfg{chroot}//; 101 print "chroot tt dir is $chroot_tt_dir\n"; 102 103 my $config = { INCLUDE_PATH => $chroot_tt_dir }; 104 my $template = Template->new($config) || die $Template::ERROR . "\n"; 105 106 syslog(LOG_INFO, "child: ready"); 107 print "info: child: ready\n" if ($args{v}); 108 109 while ($request->Accept() >= 0) { 110 # header, XXX: cache control timestamps? 111 print "Content-Type: text/html\r\n\r\n"; 112 113 # incoming query string is http mangled 114 my (undef, $input) = split("=", $ENV{QUERY_STRING}); 115 $input = uri_unescape($input); 116 117 # fuzzy search on manufacturer and part number 118 $srch_sth->execute("%$input%", "%$input%"); 119 my $vars = { query => $input, results => $srch_sth->fetchall_arrayref() }; 120 121 $template->process("search.tt", $vars) 122 || print "template: " . $template->error(); 123 } 124 125 sub child_sig_handler 126 { 127 $request->LastCall(); 128 print "info: child: caught sig" . lc shift . "\n" if ($args{v}); 129 }