#!/usr/bin/perl -w
#
# Simple Flash Socket Policy Server
# http://www.lightsphere.com/dev/articles/flash_socket_policy.html
#
# Copyright (C) 2008 Jacqueline Kira Hamilton
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
use Socket;
use IO::Handle;
 
use Proc::Daemon;
use Proc::PID::File;
 
Proc::Daemon::Init();
 
Proc::PID::File->running();
 
my $port = 843;
my $proto = getprotobyname('tcp');
 
my $logfile = "log_$port";
my $should_be_logging = 1;  # change to 0 to turn off logging.
 
if ($should_be_logging) {
    open(LOG, ">$logfile") or warn "Can't open $logfile: $!\n";
    LOG->autoflush(1);
}
 
# start the server:
 
      &log("Starting server on port $port");
    socket(Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 1 ) or die "setsockopt: $!";
      bind(Server,sockaddr_in($port,INADDR_ANY)) or die "bind: $!";
    listen(Server,SOMAXCONN) or die "listen: $!";
 
    Server->autoflush( 1 );
 
my $paddr;
&log("Server started. Waiting for connections.");
 
$/ = "\0";      # reset terminator to null char
 
# listening loop.
 
for ( ; $paddr = accept(Client,Server); close Client) {
    Client->autoflush(1);
    my($port,$iaddr) = sockaddr_in($paddr);
    my $ip_address   = inet_ntoa($iaddr);
    my $name         = gethostbyaddr($iaddr,AF_INET) || $ip_address;
    &log( scalar localtime() . ": Connection from $name" );
 
    my $line = <Client>;
    &log("Input: $line");
 
    if ($line =~ /.*policy\-file.*/i) {
        print Client &xml_policy;
    }
}
 
sub xml_policy {
    my $str = qq(<cross-domain-policy><site-control permitted-cross-domain-policies="all"/><allow-access-from domain="*" to-ports="*" /></cross-domain-policy>\0);
    return $str;
}
 
sub log {
    my($msg) = @_;
    if ($should_be_logging) {
        print LOG $msg,"\n";
    }
}