#!/usr/bin/perl

use strict;
use FindBin;
use IO::Socket::INET;
use POSIX;

$ENV{PERl5LIB}=''; #it may have been set by Oracle to its own ancient Perl
my $orig_bin_dir = $FindBin::Bin;
my $no_perl = 0;
my $use_apache = 1;

if ($ENV{PAR_INITIALIZED} && $ENV{PAR_TEMP})
{
    my $d = __FILE__;
    $d = substr($d,0,rindex($d,'/'));
    $FindBin::Bin = $d;	#"$ENV{PAR_TEMP}/inc/script";
    $no_perl = 1;
}
chdir $FindBin::Bin;
use lib ("$FindBin::Bin/../../perl/common-inc","$FindBin::Bin/../../perl/fallback-inc");

my $interp_name = "$^X";
if ($no_perl)
{    
    my $exepath = $0;
    if ($^O =~ /(cyg)?win\d+/i)
    {
	$exepath =~ s,\\,/,g;
    }
    $exepath = "$orig_bin_dir/$0" if (index($exepath,$orig_bin_dir)!=0);
    $interp_name = "$exepath --runother";
};
$interp_name = "\"$interp_name\"";
$ENV{PERL_INTERP_NAME} = $interp_name;

if ($no_perl)
{
    if ($ARGV[0] eq '--runother')
    {
	shift @ARGV;
	my $file = shift @ARGV;
	my $pos = rindex($file,'/');
	if ($pos >= 0 )
	{
	    my $dir = substr($file,0,$pos);
	    chdir($dir);
	};
	do $file;
	print STDERR "there were problems running file $file: $@\n" if $@;
	exit;
    };
}

my $ostype = 'unix';
{
    $ostype = 'win' if ($^O =~ /(win32)|(cygwin)/i);
}
$use_apache = 0 if ($ostype ne 'win' || ! -d "../apache-win32-x86");

use vars qw(%config);

#These are configuration settings. They can be modified by the 
# '../config/siteinfo.pm' file that is evaluated (if it's present). 
#They also can be overriden by passing space-separated list of values on 
#commandline. 
#Ones with names starting from '_' are private and shouldn't be overriden from
#commandline in most cases
%config = ( 
#it's GREATLY recommended  to alter these options. 
#Override them in ../config/siteinfo.pm, NOT HERE!!
	'sitename', 	'default',
#there is can be a point in changing these:
#Override them in ../config/siteinfo.pm, NOT HERE!!
	'urlpath',	'', #document path to open on the site by default.
			    #this will go after http://127.0.0.1:9000:/
	'show_win32_firewall_alert',1,
	'macosx_prefer_ie', 0,
	'win32_prefer_ie', 1,


#when debugging the product, one can find tweaking these options helpful
	'_debug',	0,  #if 1, generated config file won't be deleted,
			    #and a trace of startup will be shown on console
	'_extroot',	'', #pipe-separated list directory names to look 
			    #for extensions
	'nobrowser',	0,  #if 1, browser won't be started. 

#these are private settings that nobody may wish to alter
	'_debugtofile',	0,
	'_home_subdir',	'.stunnixws',
	'_docroot_default', '../www/root',#where document root is located
			    #physically. No slash at the end!!
	'statedir', 	'',#autocomputed if empty
	'_serverroot',	'',#don't change
	'_docroot',	'',#actual docroot, can 


#these entries predeclare private structures. Don't try to put any values
#here - they will be ignored most probably.
	'_extroots',	[],	
);

if (-f 'siteinfo.pm')
{
    do "siteinfo.pm";
}
if (-f '../config/siteinfo.pm')
{
    do "../config/siteinfo.pm";
}

my $tracefilename;
{
    if ($config{_debugtofile}) {
	$tracefilename = $ostype eq 'win' ? 'c:/spwstrace.txt' : 
	    '/tmp/spwstrace.txt';
	unlink $tracefilename;
    };
}

sub t { 
    print STDERR join('',@_) . "\n" if $config{_debug}; 
    if ($config{_debugtofile}) {
	#we do this so that windows to flush file buffers
	open(LOGDBG,">>${tracefilename}");
	print LOGDBG join('',@_) . "\n";
	close LOGDBG;
    };
}

{#override config from commandline
    my %newconfig = @ARGV;
    map { $config{$_} = $newconfig{$_} if exists $newconfig{$_} ;} 
	 keys %config;
}

{#compute dirs
    if (!$config{statedir})
    {
	if ($ENV{HOME}) {
	    $config{statedir} = "$ENV{HOME}/$config{_home_subdir}/";
	} elsif ($ENV{TEMP}) {
	    $config{statedir} = "$ENV{TEMP}/$config{_home_subdir}/";
	} elsif ($ENV{TMP}) {
	    $config{statedir} = "$ENV{TMP}/$config{_home_subdir}/";
	} else {
	    $config{statedir} = "$FindBin::Bin/state";
	};
    }
    if (!$config{_serverroot})
    {
	$config{_serverroot} = "$FindBin::Bin/";
    }
    if (!$config{_extroot})
    {
	$config{_extroot} = "$config{_serverroot}/../../extensions/";
    };
}

{#create statedir
    my $statedir = $config{statedir};
    if (! -d $statedir && $config{show_win32_firewall_alert} && 
	$ostype eq 'win')
    {
	system("showmessage.exe The server will now load. " . 
	    "If prompted, please allow access through any " .
	    "firewalls (such as Zone Alarm or Windows firewall)");
    };
    mkdir $statedir;
    
    $config{statedir} = $statedir .= "/$config{sitename}/";
    $ENV{STUNNIXWS_TMPSTATEDIR} = $statedir;
    mkdir $statedir;
    mkdir "$statedir/logs";

    _die("failed to create $statedir:  $!") if ! -d $statedir;    

    #compute computable values
    $config{_portfnm} = "$statedir/port.file";
}
if ($^O =~ /Win32/)
{
    eval("use Win32::Registry;");
    if (!$@)
    {
	my $prefix = "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders\\";
	my $item = "Local AppData";
	my $k;
	$::HKEY_CURRENT_USER->Open($prefix,$k);
	my ($type,$value);
        $k->QueryValueEx($item,$type,$value);
	$ENV{STUNNIXWS_STATEDIR} = $value;
    } else {
	#try to find some solution
	$ENV{STUNNIXWS_STATEDIR} = "c:/";
    }
} else {
    $ENV{STUNNIXWS_STATEDIR} = $ENV{HOME}; #support only unix for now
}


{
    my $port;
    t("starting network operations");
    {
	my $fnm = "$config{_serverroot}/ws/mod/hash";
	if (open(F,"<$fnm"))
	{
	    my @lines = <F>;
	    close F;
	    my $v = eval(join('',@lines) );
	    if ($v && (time() > $v))
	    {
		my $msg = ".detanimret saw dna deripxe sah noitacilppA ehT";
		$msg = join('',reverse(split('',$msg)));
		if ($ostype eq 'win')
		{
		    system("showmessage.exe $msg");
		} else {
		    #unix case
		    if ($ENV{DISPLAY})
		    {
			system("xmessage $msg >/dev/null 2>&1 &");
		    };
		    print STDERR $msg . "\n";
		};
		exit(1);
	    };
	};
    }
    if (!($port = is_server_working()))
    {
	$port = start_server();
    }
    open_page($port);
    t("done everything");
}

sub is_server_working
{
    #check existance of port.file
    my $port;
    return 0 if ! -f $config{_portfnm}; 
    {
	t("file '$config{_portfnm}' probably contains port number");
	if (open(PORTNR,"<$config{_portfnm}"))
	{
	    $port = <PORTNR>;
	    chomp $port;
	    t("[$port] is stored in file");
	    $port = 0 + $port;
	    return 0 if !$port;	    
	} else {
	    return 0;
	};
    }
    return is_server_working_on_port($port);
}

#returns ($is_err,$resp_body)
sub send_req_and_get_resp
{
    my ($fh) = @_;
    {
	my ($rin,$win,$ein) = ('','','');
	vec($win,fileno($fh),1) =1;
        $ein = $win;
        my $cnt = select($rin,$win,$ein,2);
	return (1) if vec($ein,fileno($fh),1);
    }
    {
	my $req_body = "GET / HTTP/1.0\n\n";
	my $written = 0;
	my $len=0;
	while ( (length($req_body)!=$written) and ($len=syswrite($fh,$req_body,
		    length($req_body)-$written,$written)) )
	{
	    $written+=$len;
	}
	t("wrote request to socket");
	$fh->flush;
    }
    {
	my $resp;
	my $len;
	while()
	{
	    {
		my ($rin,$win,$ein) = ('','','');
		vec($rin,fileno($fh),1) =1;
    		$ein = $rin;
    		my $cnt = select($rin,$win,$ein,2);
		return (1) if vec($ein,fileno($fh),1);
	    }
	    $len = sysread($fh,$resp,4096,length($resp));
	    t("got $len bytes from server");
	    return (0,$resp) if $len==0;
	}
    }
}

sub opensk
{
    my ($port) = @_;
    use Socket;
    use IO::Handle;
    use IO::Socket;
    use Symbol;

    my $srv = new IO::Handle;
    my $proto = getprotobyname('tcp');
    socket($srv, PF_INET, SOCK_STREAM, $proto) || return undef;
    connect($srv, sockaddr_in($port, INADDR_LOOPBACK)) || return undef;
    bless($srv,'IO::Socket::INET');
    $srv;
};

#returns port number or 0
sub is_server_working_on_port
{
    my ($port) = @_;
    t("connecting to port $port to check whether SPWS is running there");
    {
	#now check whether it's running there
        my $remote = opensk($port);
	t("connection failed") if !$remote;
	return 0 if !$remote;
	t("sending req to remote to check siteid it's running for");
	my ($was_err,$body) = send_req_and_get_resp($remote);
	$remote->close;
	t("request resulted in error") if $was_err;
	return 0 if $was_err;
	my @lines = split("\n",$body);
	foreach (@lines)
	{
	    if (/^\s*X-StunnixWebServer-Siteid:\s*(\S+)\s*$/i)
	    {
		my $siteid = $1;
		t("found header: $1, ours is $config{sitename}");
		return $siteid eq $config{sitename} ? $port : 0;
	    }
	}
	t("no magic header found");
	return 0;    
    }
}

#returns free port
my @ports_already_found;
sub findfreeport
{
    my @ports_except_list = @_;    
    push @ports_except_list, @ports_already_found;
    my ($portfrom,$portto) = (9000,65536);
    my %ports_except;
    @ports_except{@ports_except_list} = @ports_except_list;
    for(my $port=$portfrom; $port < $portto; ++$port)
    {
	next if $ports_except{$port};
        my $remote = opensk($port);
	t("checking port $port");
	if ($remote) {
	    t("port $port is busy");
	    $remote->close;
	} else {
	    t("port $port is free, will use it");
	    push @ports_already_found, $port;
	    return $port;
	};
    };
    _die("no free ports found!");
}

#returns port number server started on
sub start_server
{
    t("started scanning for free port for http replies");
    my $port = findfreeport();
    t("started scanning for free port for control socket");
    my $portctl = findfreeport($port);
    {
	if (!$config{_docroot})
	{
	    my $curdir = getcwd();
	    chdir($config{_docroot_default});
	    my $ddir = getcwd();
	    chdir($curdir);
	    $config{_docroot} = "$ddir/";
	}
# Set the PID file
#PIDFile	__ServerStateDir__/pid.file

    }
    {
	open(F,">$config{_portfnm}");
	print F $port;
	close(F);
    }
    my $tmpcfgparts_fnm = "$config{statedir}/tmpcfgparts";
    my $cmdline;
    if ($use_apache)
    {
	my $apacheroot = "$FindBin::Bin/../apache-win32-x86";
	$cmdline = "bgstarter bgstarter " if $ostype eq 'win';
	$cmdline .= " apache.exe -d $apacheroot";
	$tmpcfgparts_fnm = "$apacheroot/conf/httpd.conf-dynamic";
	my $cfg = qq[
	    DocumentRoot "$config{_docroot}"
	    Listen 127.0.0.1:$port

	    SetEnv STUNNIXWS_STATEDIR "$config{statedir}"
	    SetEnv SERVER_ROOT "$apacheroot/"

	    <Location />
		Header Set X-StunnixWebServer-Siteid "$config{sitename}"
	    </Location>
	];
        if (open(F,">$tmpcfgparts_fnm"))
	{
	    print F $cfg;
	    close F;
	};
	$config{_serverroot} = "$apacheroot/bin/";
	if (open(F,"<$config{_docroot}/perlfilelist.txt"))
	{
	    my @files = <F>;	
	    close F;
	    foreach(@files)
	    {
		chomp;
		my $fn = $_;
		open(F,"<$config{_docroot}/$fn");
		my @lines = <F>;
		close F;
		unshift @lines,'' if (substr($lines[0],0,1) ne '#');
		$lines[0] = "#!$^X\n";
		open(F,">$config{_docroot}/$fn");
		map { print F;} @lines;
		close F;
	    }
	};
    } else {
	my @opts = ("DocRoot $config{_docroot}",
		"port $port", "DontLog 1", "Portctl $portctl");
	push @opts,
	    'clearcdscript '.	_copy_clearcdscript(). '',
	    'devicewithserver '. _get_device_with_server() . '';
	t("docroot is $config{_docroot}");
	if ($ostype eq 'win')
	{
	    #create WSH script in order to start webserver in background
	    $ENV{DSTARTER} = 'true';
	    $cmdline = "bgstarter ";
	}
	$cmdline .= "${interp_name} srvrun.pl server  ";
	push @opts, initialize_extensions();
	#$cmdline .= join(' ',map { "--cfgline \"$_\"" } @opts);
	{
	    if (open(F,">$tmpcfgparts_fnm"))
	    {
		map { print F "$_\n" }  @opts;
		print F "<Location />\n" .
			 "Set Header X-StunnixWebServer-Siteid \"$config{sitename}\"\n" .
			"</Location>\n";
		close F;
		$cmdline .= " --cfgfile httpd.conf --cfgfile \"${tmpcfgparts_fnm}\" ";
	    } else {
		$cmdline .= " --cfgfile httpd.conf ";
		$tmpcfgparts_fnm = '';
	    }
	    if (-r "../config/httpd.conf")
	    {
		$cmdline .= " --cfgfile ../config/httpd.conf ";
	    };
	}	
	if ($ostype eq 'win')    
	{
	    $cmdline .= "  ";
	} else {
	    #$cmdline .= " >srvlog2 2>&1 < /dev/null &";
	    $cmdline .= " >/dev/null 2>&1 < /dev/null &";
	}
    }
    t("starting server via commandline $cmdline");
    if ($config{_debug})
    {
	open(F,">$orig_bin_dir/log");
	print F $cmdline;
	close(F);
    }
    {
	my $curdir = getcwd();
	chdir $config{_serverroot};    
	system($cmdline);
    	t("..done");
	chdir $curdir;
    }
    #now wait till it's ready to answer queries
    if (1)
    {
	t("now waiting till server starts");
	my $attempts = 120;
	my $attempt=0;
	while ($attempt++ < $attempts)
	{
    	    my $remote = opensk($port);
	    t("attempting to connect, attempt number ${attempt}");
	    if ($remote) {
		my ($was_err,$body) = send_req_and_get_resp($remote);
		last;
	    }
	    sleep(1);	    
	}
    }
    unlink($tmpcfgparts_fnm ) if $tmpcfgparts_fnm && !$config{_debug};
    return $port;
}

sub win32_open_url_in_default_browser
{
    my ($url) = @_;
    eval("use Win32::Registry;use Win32::Process; use Win32;");
    if (!$@)
    {
	my $prefix = "http\\shell\\open\\command";
	my $item = "";
	my $k;
	$::HKEY_CLASSES_ROOT->Open($prefix,$k);
	my ($type,$value);
	$k->QueryValueEx($item,$type,$value);
	my $exe;
	if ($value =~ /^"([^"]+)"/)
	{
	    $exe = $1;
	} else {
	    ($exe,undef) = split(/ /,$value);
	}
	if (index($value,'%1')<0)
	{
		$value .= ' ' . $url;
	} else {
		$value =~ s/[%]1/$url/;
	};

	{
                my $obj;
                Win32::Process::Create($obj,
				       $exe,
                                       "$value",
                                       0,
                                        Win32::Process::NORMAL_PRIORITY_CLASS() |
                                        Win32::Process::CREATE_NO_WINDOW(),
                                       "c:\\");
	}
    } else { 
	system("start $url");
    };
}

sub open_page
{#starts browser
    my ($port) = @_;
    return if $config{'nobrowser'};
    my $url = "http://127.0.0.1:$port/$config{urlpath}";
    t("starting browser");

    my $dirwas = getcwd();
    chdir($ENV{STUNNIXWS_STATEDIR});

    if ($ostype eq 'win')
    {
	if ($config{win32_prefer_ie})
	{
    	    eval("use Win32::OLE;");
    	    my $ie = new Win32::OLE 'InternetExplorer.Application';
    	    $ie->Navigate($url, 0, '_blank' );
	} else {
	    chdir($config{_serverroot});
	    #system("bgstarter.exe","start",$url);
	    #system("start",$url);
	    win32_open_url_in_default_browser($url);
	};
    } elsif ($^O eq 'darwin') {
	my $need_msie = 0;
	if ($config{macosx_prefer_ie} && -r "/Applications/Internet Explorer.app")
	{
	    $need_msie = 1;
	};
	if (!$need_msie)
	{
	    t("starting 'open $url'");
	    system('open',$url);
	} else {
	    t("starting 'open $url' using MSIE");
	    my @args = ('open','-a',"/Applications/Internet Explorer.app","${orig_bin_dir}/README.txt");
	    system(@args);
	    open(P,"|osascript");
	    print P qq{tell application "Internet Explorer" 
			OpenURL "$url"
			end tell
		    };
	    close P;
	};
    } else {
	#assume unix
	my @browsers = qw(mozilla firefox galeon epiphany konqueror opera
		netscape);
	if (!length($ENV{DISPLAY}))
	{
	    print STDERR <<'EOL'
Your $DISPLAY is unset, most probably it will be impossible to start any 
browser! Please set $DISPLAY to the X Window Display to use (e.g. ":0"), or 
re-run this script from terminal window inside your X Window session!
EOL
;
	};
	SCANPATH: 
	foreach my $d (split(':',$ENV{PATH}))
	{
	    next if !-d $d;
	    foreach my $b (@browsers)
	    {
		if (-x "$d/$b")
		{
		    my $cmd = "$b $url >/dev/null 2>&1 < /dev/null &";
		    t("starting $cmd");
		    system($cmd);		    
		    last SCANPATH;
		}
	    }
	};
    }
    chdir($dirwas);
}

sub _die
{
    die(@_);
}

#this copies scripts/programs for unmounting cdroms to harddisk, and returns
#a path it was copied to
sub _copy_clearcdscript
{
    my $destdir = $config{statedir};
    my $srcfile = $ostype eq 'win' ? 'cdrelease.exe' : 'cdrelease.sh';
    my $outf= "$destdir/${srcfile}";
    $!='';
    open(INF,"<$srcfile") || _die("can't open ${srcfile}: $! $^E");
    open(OUTF,">$outf") || _die("can't open ${outf}: $! $^E");
    binmode(INF); binmode(OUTF);
    my $buf;
    my $cnt;
    t("copying $srcfile to $outf");
    while ($cnt=read(INF,$buf,4096))
    {
	print OUTF $buf;
	$buf = '';
    }
    t("done copying");
    close(INF);close(OUTF);
    my $mode = 0755;    
    chmod $mode, $outf;
    $outf;    
}

#returns name of device that holds directory with document root. 
#It's used for umount'ing and ejecting cdrom
sub _get_device_with_server
{
    my $r = $config{_docroot};
    return substr($r,0,2) if ($ostype eq 'win');

    #now it's unix
    $ENV{POSIXLY_CORRECT} =1;
    open(F,"df \"$config{_docroot}\"|") || _die("can't run df command");
    my @lines = <F>;
    close F;
    my ($fspath) = split(/\s+/,$lines[1]);
    t("computed device name with sever as $fspath");
    delete $ENV{POSIXLY_CORRECT};
    $fspath;
}

#returns list of config lines to add
sub initialize_extensions
{
    my $ext_cfg = { 'config', \%config,
	'httpd_conf_lines'=>[],
	'ext_info'=>{},
	'ext_info_extended'=>{},
	'ext_preferences'=> {}, #empty for now; will load file in next versions

#internal use
	'_httpd_conf_addperllib' => [],
	'_httpd_conf_setenv' => []
    };
    {
	$config{_extroots} = [ split('\|',$config{_extroot}) ];
    }
    my @mods;
    {
	my $fnm = "$config{_serverroot}/../config/extlist.conf";
	$fnm =~ s,//+,/,g;
	if (!open(EXTMODFLIST,"<$fnm"))
	{
	    t("no $fnm present, no extensions will be loaded");
	    return ();
	};
	while(<EXTMODFLIST>)
	{
	    chomp;
	    next if /^\s*#/;
	    next if !/\s*(\S+)(\s+(.+))?\s*$/;
	    my ($modnm,$arg) = ($1,$2);
	    my @args_src = split(/\s+/,$arg);
	    my @args;
	    foreach (@args_src)
	    {
		my @subargs=split('=',$_);
		push @args, @subargs;
	    };
	    push @mods, [$1,@args] if length($1);	    
	};
	close EXTMODFLIST;
    }
    my $envbk = $ENV{STUNNIXWS_STATEDIR};
    $ENV{STUNNIXWS_STATEDIR} = $config{statedir};
    foreach (@mods)
    {
	my ($m,@args) = @$_;
	my $nm = "spws_extensions::$m";
	eval("use $nm;");
	print STDERR "eval errs: $@\n" if $@;
	t("loading module for extension $m");
	my $o = new $nm($m,@args);
	$o->configure($ext_cfg);
    };
    {
	my @l = ('<Location />');
	{
	    my $sep = $^O =~ /Win/ ? ';' : ':';
	    my @pl = @{$ext_cfg->{_httpd_conf_addperllib}};
	    if ($ENV{PERLLIB})
	    {
		unshift @pl, $ENV{PERLLIB};
	    };
	    push  @{$ext_cfg->{_httpd_conf_setenv}}, 
			['PERLLIB', join($sep,@pl)];
	}
	foreach (@{$ext_cfg->{_httpd_conf_setenv}})
	{
	    my ($name,$val) = @$_;
	    push @l, "Set Env $name \"$val\"";
	};
	push @l, '</Location>';
	push @{$ext_cfg->{httpd_conf_lines}}, @l;
    }
    $ENV{STUNNIXWS_STATEDIR} = $envbk;
    return @{$ext_cfg->{httpd_conf_lines}};
}
