openpkg-packages/flashpolicyd/flashpolicyd.pl

#!/usr/bin/env perl
##
##  flashpolicyd.pl -- Adobe Flash Policy File Server
##  Copyright (c) 2005 Adobe Systems Incorporated
##  Copyright (c) 2009 Ralf S. Engelschall <rse@engelschall.com>
##

use strict;
use Socket;

my $NULLBYTE = pack('c', 0);
my $uid = 65534;
my $gid = 65534;
my $host = "0.0.0.0";
my $port = 843;
my $cfgfile;
my $logfile;
my $content;

while (my $arg = shift @ARGV) {
    if ($arg =~ m/^--host=(\d+)$/) {
        $host = $1;
    }
    elsif ($arg =~ m/^--port=(\d+)$/) {
        $port = $1;
    }
    elsif ($arg =~ m/^--cfg=(.*)/) {
        $cfgfile = $1;
    }
    elsif ($arg =~ m/^--log=(.*)/) {
        $logfile = $1;
    }
    elsif ($arg =~ m/^--uid=(.*)/) {
        $uid = $1;
    }
    elsif ($arg =~ m/^--gid=(.*)/) {
        $gid = $1;
    }
}
unless ($cfgfile) {
    die "Usage: flashpolicyd [--host=IP] [--port=N] --cfg=FILE [--log=FILE] [--uid=N] [--gid=N]\n";
}

-f $cfgfile or die "No such file: '$cfgfile'\n";
-s $cfgfile < 10_000 or die "File probably too large to be a policy file: '$cfgfile'\n";

local $/ = undef;
open POLICYFILE, "<$cfgfile" or die "Can't open '$cfgfile': $!\n";
$content = <POLICYFILE>;
close POLICYFILE;

$content =~ m/cross-domain-policy/ or die "Not a valid policy file: '$cfgfile'\n";

socket(LISTENSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "socket() error: $!";
setsockopt(LISTENSOCK, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) or die "setsockopt() error: $!";
bind(LISTENSOCK, sockaddr_in($port, $host eq "0.0.0.0" ? INADDR_ANY : inet_aton($host))) or die "bind() error: $!";
listen(LISTENSOCK, SOMAXCONN) or die "listen() error: $!";

$< = $uid;
$( = $gid;
$> = $<;
$) = $(;
umask(022);

sub logbook {
    my ($msg) = @_;
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
    open LOGFILE, ">>$logfile" or die "Can't open '$logfile': $!\n";
    printf(LOGFILE "[%04d-%02d-%02dT%02d:%02d:%02d] %s\n", 1900+$year, $mon, $mday, $hour, $min, $sec, $msg);
    close LOGFILE
}

logbook("startup (listening at $host:$port, running under $uid/$gid)");

while (my $clientAddr = accept(CONNSOCK, LISTENSOCK)) {
    my ($clientPort, $clientIp) = sockaddr_in($clientAddr);
    my $clientIpStr = inet_ntoa($clientIp);
    logbook("[$clientIpStr:$clientPort] connection opened");

    local $/ = $NULLBYTE;
    my $request = <CONNSOCK>;
    chomp $request;

    if ($request ne '<policy-file-request/>') {
        $request =~ s/([^a-zA-Z0-9<>\/]+)/sprintf("\\x%02x", ord($1))/sge;
        logbook("[$clientIpStr:$clientPort] unrecognized request: \"$request\"");
        close CONNSOCK;
        next;
    }

    logbook("[$clientIpStr:$clientPort] send response");

    print CONNSOCK $content;
    print CONNSOCK $NULLBYTE;
    close CONNSOCK;

    logbook("[$clientIpStr:$clientPort] connection closed");
}