Przeglądaj źródła

First Commit Linux Agent

Andre 12 lat temu
commit
9ce6ed21f6

+ 22 - 0
.gitattributes

@@ -0,0 +1,22 @@
+# Auto detect text files and perform LF normalization
+* text=auto
+
+# Custom for Visual Studio
+*.cs     diff=csharp
+*.sln    merge=union
+*.csproj merge=union
+*.vbproj merge=union
+*.fsproj merge=union
+*.dbproj merge=union
+
+# Standard to msysgit
+*.doc	 diff=astextplain
+*.DOC	 diff=astextplain
+*.docx diff=astextplain
+*.DOCX diff=astextplain
+*.dot  diff=astextplain
+*.DOT  diff=astextplain
+*.pdf  diff=astextplain
+*.PDF	 diff=astextplain
+*.rtf	 diff=astextplain
+*.RTF	 diff=astextplain

+ 10 - 0
.gitignore

@@ -0,0 +1,10 @@
+*.swp
+agent/Cfg
+agent/ogp_agent.pid
+agent/ogp_agent.log*
+agent/startups
+agent/steamc
+upload/includes/config.inc.php
+agent/ogp_agent.pl.bak
+agent/ogp_agent.pl.tdy
+*/screenlog.0

+ 339 - 0
COPYING

@@ -0,0 +1,339 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 2 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, write to the Free Software Foundation, Inc.,
+    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.

+ 8 - 0
Cfg/Config.pm

@@ -0,0 +1,8 @@
+%Cfg::Config = (
+    logfile => 'ogp_agent.log',
+    listen_port  => '12679',
+    listen_ip => '0.0.0.0',
+    version => 'v1.0',
+    key => 'test1',
+    steam_license => 'Accept',
+    );

+ 12 - 0
Cfg/Preferences.pm

@@ -0,0 +1,12 @@
+%Cfg::Preferences = (
+    screen_log_local => 1,
+    delete_logs_after => 30,
+    );
+
+# screen_log_local
+	# 1 = Create a local log copy in the user's server home directory
+	# 0 = Do not create a local log copy
+
+# delete_logs_after
+	# Specify when to delete old backup log files to free space after a specified number of days.  
+	# Integer value only that must be greater than 0 [default 30 days old]

+ 1 - 0
Cfg/bash_prefs.cfg

@@ -0,0 +1 @@
+agent_auto_update=1

+ 230 - 0
Crypt/XXTEA.pm

@@ -0,0 +1,230 @@
+#/**********************************************************\
+#|                                                          |
+#| The implementation of PHPRPC Protocol 3.0                |
+#|                                                          |
+#| xxtea.pm                                                 |
+#|                                                          |
+#| Release 3.0.0 beta                                       |
+#| Copyright (c) 2005-2007 by Team-PHPRPC                   |
+#|                                                          |
+#| WebSite:  http://www.phprpc.org/                         |
+#|           http://www.phprpc.net/                         |
+#|           http://www.phprpc.com/                         |
+#|           http://sourceforge.net/projects/php-rpc/       |
+#|                                                          |
+#| Author:   Ma Bingyao <[email protected]>                  |
+#|                                                          |
+#| This file may be distributed and/or modified under the   |
+#| terms of the GNU Lesser General Public License (LGPL)    |
+#| version 3.0 as published by the Free Software Foundation |
+#| and appearing in the included file LICENSE.              |
+#|                                                          |
+#\**********************************************************/
+#
+# XXTEA encryption arithmetic module.
+#
+# Copyright (C) 2006-2007 Ma Bingyao <[email protected]>
+# Version:      1.00
+# LastModified: Nov 7, 2007
+# This library is free.  You can redistribute it and/or modify it.
+#
+
+package Crypt::XXTEA;
+
+use bytes;
+use integer;
+use strict;
+
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT);
+
+$VERSION     = 1.00;
+@ISA         = qw(Exporter);
+@EXPORT      = qw(xxtea_encrypt xxtea_decrypt);
+
+*encrypt = \&xxtea_encrypt;
+*decrypt = \&xxtea_decrypt;
+
+sub _long2str {
+    my ($v, $w) = @_;
+    my $len = @{$v};
+    my $n = ($len - 1) << 2;
+    if ($w) {
+        my $m = $v->[$len - 1];
+        if (($m < $n - 3) || ($m > $n)) {
+            return 0;
+        }
+        $n = $m;
+    }
+    my @s = ();
+    for (my $i = 0; $i < $len; $i++) {
+        $s[$i] = pack("V", $v->[$i]);
+    }
+    if ($w) {
+        return substr(join('', @s), 0, $n);
+    }
+    else {
+        return join('', @s);
+    }
+}
+
+sub _str2long {
+    my ($s, $w) = @_;
+    my @v = unpack("V*", $s. "\0"x((4 - length($s) % 4) & 3));
+    if ($w) {
+        $v[@v] = length($s);
+    }
+    return @v;
+}
+
+sub xxtea_encrypt {
+    my ($s, $k) = @_;
+    if ($s eq "") {
+        return "";
+    }
+    my @v = _str2long($s, 1);
+    my @k = _str2long($k, 0);
+    if (@k < 4) {
+        for (my $i = @k; $i < 4; $i++) {
+            $k[$i] = 0;
+        }
+    }
+    my $n = $#v;
+    my $z = $v[$n];
+    my $y = $v[0];
+    my $delta = 0x9E3779B9;
+    my $q = 6 + 52 / ($n + 1);
+    my $sum = 0;
+    my $e;
+    my $p;
+    my $mx;
+    while (0 < $q--) {
+        $sum = ($sum + $delta) & 0xffffffff;
+        $e = $sum >> 2 & 3;
+        for ($p = 0; $p < $n; $p++) {
+            $y = $v[$p + 1];
+            $mx = ((($z >> 5 & 0x07ffffff) ^ $y << 2) + (($y >> 3 & 0x1fffffff) ^ $z << 4)) ^ (($sum ^ $y) + ($k[$p & 3 ^ $e] ^ $z)) & 0xffffffff;
+            $z = $v[$p] = ($v[$p] + $mx) & 0xffffffff;
+        }
+        $y = $v[0];
+        $mx = ((($z >> 5 & 0x07ffffff) ^ $y << 2) + (($y >> 3 & 0x1fffffff) ^ $z << 4)) ^ (($sum ^ $y) + ($k[$p & 3 ^ $e] ^ $z)) & 0xffffffff;
+        $z = $v[$n] = ($v[$n] + $mx) & 0xffffffff;
+    }
+    return _long2str(\@v, 0);
+}
+
+sub xxtea_decrypt {
+    my ($s, $k) = @_;
+    if ($s eq "") {
+        return "";
+    }
+    my @v = _str2long($s, 0);
+    my @k = _str2long($k, 0);
+    if (@k < 4) {
+        for (my $i = @k; $i < 4; $i++) {
+                $k[$i] = 0;
+        }
+    }
+    my $n = $#v;
+    my $z = $v[$n];
+    my $y = $v[0];
+    my $delta = 0x9E3779B9;
+    my $q = 6 + 52 / ($n + 1);
+    my $sum = ($q * $delta) & 0xffffffff;
+    my $e;
+    my $p;
+    my $mx;
+    while ($sum != 0) {
+        $e = $sum >> 2 & 3;
+        for ($p = $n; $p > 0; $p--) {
+            $z = $v[$p - 1];
+            $mx = ((($z >> 5 & 0x07ffffff) ^ $y << 2) + (($y >> 3 & 0x1fffffff) ^ $z << 4)) ^ (($sum ^ $y) + ($k[$p & 3 ^ $e] ^ $z)) & 0xffffffff;
+            $y = $v[$p] = ($v[$p] - $mx) & 0xffffffff;
+        }
+        $z = $v[$n];
+        $mx = ((($z >> 5 & 0x07ffffff) ^ $y << 2) + (($y >> 3 & 0x1fffffff) ^ $z << 4)) ^ (($sum ^ $y) + ($k[$p & 3 ^ $e] ^ $z)) & 0xffffffff;
+        $y = $v[0] = ($v[0] - $mx) & 0xffffffff;
+        $sum = ($sum - $delta) & 0xffffffff;
+    }
+    return _long2str(\@v, 1);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Crypt::XXTEA - XXTEA encryption arithmetic module.
+
+=head1 SYNOPSIS
+
+    use Crypt::XXTEA;
+
+=head1 DESCRIPTION
+
+XXTEA is a secure and fast encryption algorithm. It's suitable for web development. This module allows you to encrypt or decrypt a string using the algorithm. 
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item xxtea_encrypt
+
+    my $ciphertext = xxtea_encrypt($plaintext, $key);
+
+This function encrypts $plaintext using $key and returns the $ciphertext.
+
+=item encrypt
+
+    my $ciphertext = Crypt::XXTEA::encrypt($plaintext, $key);
+   
+This function is the same as xxtea_encrypt.
+
+=item xxtea_decrypt
+
+    my $plaintext = xxtea_decrypt($ciphertext, $key);
+
+This function decrypts $ciphertext using $key and returns the $plaintext.
+
+=item decrypt
+
+    my $plaintext = Crypt::XXTEA::decrypt($ciphertext, $key);
+
+This function is the same as xxtea_decrypt.
+
+=back
+
+=head1 EXAMPLE
+
+    use Crypt::XXTEA;
+    my $ciphertext = xxtea_encrypt("Hello XXTEA.", "1234567890abcdef");
+    my $plaintext = xxtea_decrypt($ciphertext, "1234567890abcdef");
+    print $plaintext;
+
+    $ciphertext = Crypt::XXTEA::encrypt("Hi XXTEA.", "1234567890abcdef");
+    $plaintext = Crypt::XXTEA::decrypt($ciphertext, "1234567890abcdef");
+    print $plaintext;
+
+=head1 NOTES
+
+If $plaintext is equal to "", it returns "".
+
+It returns 0 when fails to decrypt.
+
+Only the first 16 bytes of $key is used. if $key is shorter than 16 bytes, it will be padding \0.
+
+The XXTEA algorithm is stronger and faster than Crypt::DES, Crypt::Blowfish & Crypt::IDEA.
+
+=head1 SEE ALSO
+
+Crypt::DES
+Crypt::Blowfish
+Crypt::IDEA
+
+=head1 COPYRIGHT
+
+The implementation of the XXTEA algorithm was developed by,
+and is copyright of, Ma Bingyao ([email protected]).
+
+=cut

+ 6 - 0
DEVELOPMENT

@@ -0,0 +1,6 @@
+OGP Agent NOTES:
+
+Before committing code it is recommended to execute perltidy:
+
+$ perltidy -b -gnu ogp_agent.pl
+

+ 133 - 0
EHCP/addAccount.php

@@ -0,0 +1,133 @@
+<?php
+
+// Adds users to the database
+
+// Variables
+
+$success = 0;
+
+if (isset($_GET['username'])) {
+    $ftp_username = $_GET['username'];
+}
+
+if (isset($_GET['password'])) {
+    $ftp_pass = $_GET['password'];
+}
+
+if (isset($_GET['dir'])) {
+    $rDir = $_GET['dir'];
+}
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (file_exists("config.php")) {
+    include 'config.php';
+    mysql_select_db($dbName, $connection);
+} else {
+    die("config.php must exist within the installation root folder!");
+}
+
+// Did we properly receive the variables from the OGP agent?
+
+if (isset($ftp_username) && isset($ftp_pass) && isset($rDir)) {
+
+    // We received all necessary variables.  Process what we received.
+    $errorCount = 0;
+    $errorInstallInt = 0;
+
+    // OGP should be doing this validation... but it's not
+    
+    // Custom directory validation
+
+    
+    if (substr_count($rDir, '/') < 2) {
+        $errorCount++;
+        $errors[] = "In order to prevent security risks, users cannot be granted access to the main directories in the root file system of the server.&nbsp; You must go down two directory levels!&nbsp; Example:  /games/user1!";
+    }
+    
+    if (stripos($rDir, "/") === FALSE || stripos($rDir, "/") != 0) {
+        $errorCount++;
+        $errors[] = "You have not chosen a valid directory!";
+    }
+    
+    if ($rDir === "/var/www/" || stripos($rDir, "/var/www/") !== FALSE) {
+        $errorCount++;
+        $errors[] = "You may not create ftp accounts into the protected EHCP directories using this program.&nbsp; Create these accounts using EHCP software.";
+    }
+    
+    if (stripos($rDir, "\\")) {
+        $errorCount++;
+        $errors[] = "This is not a Windows machine... use the correct slash character for path...";
+    }
+
+    // If the last character in the path is a slash (/) - Remove it from the string
+    
+    if (substr_count($rDir, '/') >= 2 && $rDir[strlen($rDir) - 1] == "/") {
+        $end = strlen($rDir) - 2;
+        $rDir = substr($rDir, 0, $end);
+    }
+    
+    if ($errorCount == 0) {
+
+        // Security checks
+        $ftp_password_db = mysql_real_escape_string($ftp_pass);
+        $ftp_username_db = mysql_real_escape_string($ftp_username);
+        $rDir = mysql_real_escape_string($rDir);
+        $SQL = "SELECT id FROM ftpaccounts WHERE ftpusername = '$ftp_username_db'";
+        $Result = mysql_query($SQL, $connection);
+        
+        if ($Result !== FALSE) {
+            $count = mysql_num_rows($Result);
+            
+            if ($count > 0) {
+                $errorCount++;
+                $errors[] = "The FTP username supplied already exists!&nbsp; Please enter another unique username!";
+            } else {
+
+                // Make sure data enter is unique for homedir
+                $SQL = "SELECT id FROM ftpaccounts WHERE homedir = '$rDir'";
+                $Result = mysql_query($SQL, $connection);
+                
+                if ($Result !== FALSE) {
+                    $count = mysql_num_rows($Result);
+
+                    // Insert the data into the
+                    $SQL = "INSERT INTO ftpaccounts (ftpusername, password, homedir) VALUES ('$ftp_username_db', password('$ftp_password_db'), '$rDir')";
+                    $Result = mysql_query($SQL, $connection);
+                    
+                    if ($Result !== FALSE) {
+                        $success = 1;
+                    } else {
+                        $errorCount++;
+                        $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+                    }
+                } else {
+                    $errorCount++;
+                    $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+                }
+                
+                if ($errorCount > 0 && $success == 0) {
+                    unset($_POST['createFTP']);
+                    include 'admin/ftpCreateForm.php';
+                }
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+        }
+    }
+}
+
+// Log errors
+
+if ($errorCount > 0) {
+    addToLog($errors);
+}
+
+// Return value:
+
+echo $success;
+
+?>

+ 66 - 0
EHCP/config.php

@@ -0,0 +1,66 @@
+<?php
+
+/*
+This FTP addon works with EHCP (www.ehcp.net)
+It allows OGP - the open game panel - to manage custom FTP user accounts
+
+You must update these credentials before FTP integrating with EHCP will work!
+
+by own3mall
+*/
+
+// Database credentials
+$server = 'localhost';
+$login = 'ehcp';
+$dbpass = 'changeme';
+$dbName = 'ehcp';
+
+// Log File
+$logFile = 'ehcp_ftp_log.txt';
+
+function addToLog($errors) {
+    global $logFile;
+    
+    if (!file_exists($logFile)) {
+        $createLog = fopen($logFile, 'a+');
+        
+        if (!$createLog) {
+            trigger_error("Unable to create EHCP FTP Integration log file! Please create a file named \"ehcp_ftp_log.txt\" in the ogp_agent install directory under the EHCP folder with permissions of 777", E_USER_NOTICE);
+        }
+        fclose($createLog);
+    }
+    
+    if (!is_writable($logFile)) {
+        $chPerm = chmod($logFile, 777);
+        
+        if (!$chPerm) {
+            trigger_error("The $logFile file is not writable. CHMOD failed. Please manually set the chmod to 777!", E_USER_NOTICE);
+        }
+    }
+    $logContents = file_get_contents($logFile);
+    
+    foreach ($errors as $err) {
+        $logContents.= $err . "\n";
+        trigger_error($err, E_USER_NOTICE);
+        echo $err . "\n";
+    }
+    $updateLog = file_put_contents($logFile, $logContents);
+    
+    if (!$updateLog) {
+        trigger_error("Unable to write errors to the log file of $logFile", E_USER_NOTICE);
+    }
+}
+
+// Create the database connection
+$connection = mysql_connect($server, $login, $dbpass);
+
+if ($connection) {
+    mysql_select_db($dbName, $connection);
+} else {
+    $errToLog[] = 'Unable to connect to the EHCP MySQL database using provided credentials! Please update your config.php settings!';
+    addToLog($errToLog);
+    die('Unable to connect to the EHCP MySQL database using provided credentials! Please update your config.php settings!');
+}
+
+?>
+

+ 64 - 0
EHCP/delAccount.php

@@ -0,0 +1,64 @@
+<?php
+
+if (file_exists("config.php")) {
+    include 'config.php';
+} else {
+    die("config.php must exist within the installation root folder!");
+}
+
+// Deletes passed in user account from database
+
+// Unless the actual delete command fails, success should be 1... we don't care if the account doesn't exist.
+$success = 1;
+$errorCount = 0;
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (isset($_GET['username'])) {
+    $userToDelete = $_GET['username'];
+}
+
+if (!isset($userToDelete)) {
+    $errorCount++;
+    $errors[] = "No username was passed to the form.";
+} else {
+    $SQL = "SELECT ftpusername FROM ftpaccounts WHERE ftpusername = '$userToDelete'";
+    $Result = mysql_query($SQL, $connection);
+    
+    if ($Result !== FALSE) {
+        $row = mysql_fetch_row($Result);
+        $unameDeleted = $row[0];
+    }
+    
+    if (isset($unameDeleted)) {
+        $SQL = "DELETE FROM ftpaccounts WHERE ftpusername = '$userToDelete'";
+        $Result = mysql_query($SQL, $connection);
+        
+        if ($Result !== FALSE) {
+            
+            if ($unameDeleted === "none") {
+                $errorCount++;
+                $errors[] = "The specified user $userToDelete does not exist within the databse. No actions were taken!";
+            } else {
+                $success = 1;
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+            $success = 0;
+        }
+    }
+}
+
+// Log errors
+
+if ($errorCount > 0) {
+    addToLog($errors);
+}
+
+// Return value:
+echo $success;
+
+?>

+ 0 - 0
EHCP/ehcp_ftp_log.txt


+ 66 - 0
EHCP/listAllUsers.php

@@ -0,0 +1,66 @@
+<?php
+
+// Returns a list of all custom FTP users
+
+// Only custom users are setup when tying into the EHCP FTP API
+
+$countNotNull = 0;
+$users_list = "";
+$success = 0;
+$errorCount = 0;
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (!isset($connection)) {
+    include "config.php";
+}
+
+if (!isset($connection)) {
+    die("Problem setting up connection!");
+} else {
+    $SQL = "SELECT ftpusername, homedir, domainname, status FROM ftpaccounts";
+    $Result = mysql_query($SQL, $connection);
+    
+    if ($Result !== FALSE) {
+        $count = mysql_num_rows($Result);
+        
+        if ($count > 0) {
+            while ($row = mysql_fetch_assoc($Result)) {
+
+                // Only show custom entries... do not allow to modify EHCP accounts.
+                // domainname field will be NULL for custom FTP entries
+                
+                if (!empty($row['homedir']) && (empty($row['domainname']) || $row['domainname'] === NULL) && (empty($row['status']) || $row['status'] === NULL)) {
+                    $countNotNull++;
+                    $username = $row['ftpusername'];
+                    $dir = $row['homedir'];
+                    $users_list.= $username . "\t" . $dir . "/./\n";
+                }
+            }
+            
+            if ($countNotNull == 0) {
+                $errorCount++;
+                $errors[] = "There are no custom FTP accounts yet in the EHCP database!";
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "No FTP accounts exist from the ftpaccounts table!";
+        }
+    } else {
+        $errorCount++;
+        $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+    }
+
+    // Log errors
+    
+    if ($errorCount > 0) {
+        addToLog($errors);
+    }
+}
+
+// Return the user list
+echo $users_list;
+
+?>

+ 72 - 0
EHCP/showAccount.php

@@ -0,0 +1,72 @@
+<?php
+
+// Returns the information of ONE custom ftpuser
+
+// Only custom users are setup when tying into the EHCP FTP API
+
+$countNotNull = 0;
+$user_details = "";
+$success = 0;
+$errorCount = 0;
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (!isset($connection)) {
+    include "config.php";
+}
+
+if (isset($_GET['username'])) {
+    $ftp_account = $_GET['username'];
+}
+
+if (!isset($connection)) {
+    die("Problem setting up connection!");
+} else
+if (isset($ftp_account)) {
+    $SQL = "SELECT ftpusername, homedir FROM ftpaccounts WHERE ftpusername = '$ftp_account'";
+    $Result = mysql_query($SQL, $connection);
+    
+    if ($Result !== FALSE) {
+        $count = mysql_num_rows($Result);
+        
+        if ($count == 1) {
+            
+            if ($row = mysql_fetch_assoc($Result)) {
+
+                // Only show custom entries... do not allow to modify EHCP accounts.
+                
+                if (!empty($row['homedir'])) {
+                    $countNotNull++;
+                    $username = $row['ftpusername'];
+                    $dir = $row['homedir'];
+                    $user_details.= "Username" . " : " . $username . "\n";
+                    $user_details.= "Directory" . " : " . $dir . "\n";
+                }
+            }
+            
+            if ($countNotNull == 0) {
+                $errorCount++;
+                $errors[] = "There are no custom FTP accounts yet in the EHCP database!";
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "No FTP accounts exist with the given username of $ftp_account";
+        }
+    } else {
+        $errorCount++;
+        $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+    }
+
+    // Log errors
+    
+    if ($errorCount > 0) {
+        addToLog($errors);
+    }
+}
+
+// Return the user list
+echo $user_details;
+
+?>

+ 14 - 0
EHCP/syncftp.php

@@ -0,0 +1,14 @@
+<?php
+$curDir = getcwd();
+
+if(chdir("/var/www/new/ehcp/")){
+	require ("classapp.php");
+	$app = new Application();
+	$app->connectTodb(); # fill config.php with db user/pass for things to work..
+
+	$app->addDaemonOp('syncftp', '', '', '', 'sync ftp for nonstandard homes');
+}
+
+chdir($curDir);
+
+?>

+ 142 - 0
EHCP/updateInfo.php

@@ -0,0 +1,142 @@
+<?php
+
+if (file_exists("config.php")) {
+    include 'config.php';
+} else {
+    die("config.php must exist within the installation root folder!");
+}
+
+// Updates ftpuser's password
+$success = 0;
+$errorCount = 0;
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (isset($_GET['username'])) {
+    $ftp_username = $_GET['username'];
+}
+
+if (isset($_GET['password'])) {
+    $arrOfVals = trim($_GET['password']);
+}
+
+if (isset($arrOfVals) && !empty($arrOfVals)) {
+    $arrOfVals = explode("\n", $arrOfVals);
+    $arrOfVals = array_filter($arrOfVals);
+    
+    foreach ($arrOfVals as $passIn) {
+        $passIn = trim($passIn);
+
+        // Replace all tabs or spaces
+        $pattern = '/\s+/';
+        $passIn = preg_replace($pattern, ' ', $passIn);
+        $keyAndVal = explode(' ', $passIn);
+        
+        if (count($keyAndVal) == 2) {
+            $arr[$keyAndVal[0]] = $keyAndVal[1];
+        }
+        
+        if (isset($arr['new_password']) && !empty($arr['new_password'])) {
+            $ftp_pass = $arr['new_password'];
+        }
+        
+        if (isset($arr['Directory']) && !empty($arr['Directory'])) {
+            $update_dir = $arr['Directory'];
+        }
+        
+        if (isset($arr['orig_user']) && !empty($arr['orig_user'])) {
+            $ftp_old_username = $arr['orig_user'];
+        }
+        
+        if (isset($arr['Username']) && !empty($arr['Username'])) {
+            $ftp_username = $arr['Username'];
+        }
+    }
+}
+
+if (!isset($ftp_username) || !isset($update_dir)) {
+    $errorCount++;
+    $errors[] = "No FTP accounts could be modified! Updated username and homedir were not sent by the panel.";
+} else {
+    
+    if (substr_count($update_dir, '/') < 2) {
+        $errorCount++;
+        $errors[] = "In order to prevent security risks, users cannot be granted access to the main directories in the root file system of the server.&nbsp; You must go down two directory levels!&nbsp; Example:  /games/user1!";
+    }
+    
+    if (stripos($update_dir, "/") === FALSE || stripos($update_dir, "/") != 0) {
+        $errorCount++;
+        $errors[] = "You have not chosen a valid directory!";
+    }
+    
+    if ($update_dir === "/var/www/" || stripos($update_dir, "/var/www/") !== FALSE) {
+        $errorCount++;
+        $errors[] = "You may not create ftp accounts into the protected EHCP directories using this program.&nbsp; Create these accounts using EHCP software.";
+    }
+    
+    if (stripos($update_dir, "\\")) {
+        $errorCount++;
+        $errors[] = "This is not a Windows machine... use the correct slash character for path...";
+    }
+
+    // If the last character in the path is a slash (/) - Remove it from the string
+    
+    if (substr_count($update_dir, '/') > 2 && $update_dir[strlen($update_dir) - 1] == "/") {
+        $end = strlen($update_dir) - 2;
+        $update_dir = substr($update_dir, 0, $end);
+    }
+    
+    if ($errorCount == 0) {
+
+        // Security checks
+        
+        if (isset($ftp_pass)) {
+            $ftp_password_db = mysql_real_escape_string($ftp_pass);
+        }
+        $ftp_username_db = mysql_real_escape_string($ftp_username);
+        $SQL = "SELECT * FROM ftpaccounts WHERE ftpusername = '$ftp_username_db'";
+        $Result = mysql_query($SQL, $connection);
+        
+        if ($Result !== FALSE) {
+            $count = mysql_num_rows($Result);
+            
+            if ($count != 1) {
+                $errorCount++;
+                $errors[] = "FTP User " . $ftp_username . " does not exist in the database. Account information cannot be updated";
+            } else {
+
+                // Update user's password data into DB:
+                $SQL = "UPDATE ftpaccounts SET ";
+                
+                if (isset($ftp_password_db)) {
+                    $SQL.= "password=password('$ftp_password_db'), ";
+                }
+                $SQL.= "homedir='$update_dir' WHERE ftpusername='$ftp_username_db'";
+                $Result = mysql_query($SQL, $connection);
+                
+                if ($Result !== FALSE) {
+                    $success = 1;
+                } else {
+                    $errorCount++;
+                    $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+                }
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+        }
+    }
+}
+
+// Log errors
+
+if ($errorCount > 0) {
+    addToLog($errors);
+}
+
+// Return value:
+echo $success;
+
+?>

+ 80 - 0
EHCP/updatePass.php

@@ -0,0 +1,80 @@
+<?php
+
+if (file_exists("config.php")) {
+    include 'config.php';
+} else {
+    die("config.php must exist within the installation root folder!");
+}
+
+// Updates ftpuser's password
+$success = 0;
+$errorCount = 0;
+
+if (isset($errors)) {
+    unset($errors);
+}
+
+if (isset($_GET['username'])) {
+    $ftp_username = $_GET['username'];
+}
+
+if (isset($_GET['password'])) {
+    $ftp_pass = trim($_GET['password']);
+}
+
+if (!isset($ftp_username) || !isset($ftp_pass)) {
+    $errorCount++;
+    $errors[] = "No FTP accounts could be modified! Updated username and password were not sent by the OGP upload functions.";
+} else {
+    
+    if ($errorCount == 0) {
+
+        // Security checks
+        $ftp_password_db = mysql_real_escape_string($ftp_pass);
+        $ftp_username_db = mysql_real_escape_string($ftp_username);
+        $SQL = "SELECT * FROM ftpaccounts WHERE ftpusername = '$ftp_username_db'";
+        $Result = mysql_query($SQL, $connection);
+        
+        if ($Result !== FALSE) {
+            $count = mysql_num_rows($Result);
+            
+            if ($count != 1) {
+                $errorCount++;
+                $errors[] = "The account information was not updated because the FTP username $ftp_old_username never existed in the first place and cannot be modified";
+            } else {
+                
+                if ($row = mysql_fetch_assoc($Result)) {
+                    $recordID = $row['id'];
+                }
+
+                // Update user's password data into DB:
+                $SQL = "UPDATE ftpaccounts SET password=password('$ftp_password_db') WHERE ftpusername='$ftp_username_db'";
+                $Result = mysql_query($SQL, $connection);
+                
+                if ($Result !== FALSE) {
+                    $success = 1;
+                } else {
+                    $errorCount++;
+                    $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+                }
+            }
+        } else {
+            $errorCount++;
+            $errors[] = "Error code " . mysql_errno($connection) . ": " . mysql_error($connection);
+        }
+    }
+}
+
+
+
+// Log errors
+
+if ($errorCount > 0) {
+    addToLog($errors);
+}
+
+// Return value:
+
+echo $success;
+
+?>

+ 696 - 0
File/Copy/Recursive.pm

@@ -0,0 +1,696 @@
+package File::Copy::Recursive;
+
+use strict;
+BEGIN {
+    # Keep older versions of Perl from trying to use lexical warnings
+    $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
+}
+use warnings;
+
+use Carp;
+use File::Copy; 
+use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
+
+use vars qw( 
+    @ISA      @EXPORT_OK $VERSION  $MaxDepth $KeepMode $CPRFComp $CopyLink 
+    $PFSCheck $RemvBase $NoFtlPth  $ForcePth $CopyLoop $RMTrgFil $RMTrgDir 
+    $CondCopy $BdTrgWrn $SkipFlop  $DirPerms
+);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
+$VERSION = '0.38';
+
+$MaxDepth = 0;
+$KeepMode = 1;
+$CPRFComp = 0; 
+$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
+$PFSCheck = 1;
+$RemvBase = 0;
+$NoFtlPth = 0;
+$ForcePth = 0;
+$CopyLoop = 0;
+$RMTrgFil = 0;
+$RMTrgDir = 0;
+$CondCopy = {};
+$BdTrgWrn = 0;
+$SkipFlop = 0;
+$DirPerms = 0777; 
+
+my $samecheck = sub {
+   return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
+   return if @_ != 2 || !defined $_[0] || !defined $_[1];
+   return if $_[0] eq $_[1];
+
+   my $one = '';
+   if($PFSCheck) {
+      $one    = join( '-', ( stat $_[0] )[0,1] ) || '';
+      my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
+      if ( $one eq $two && $one ) {
+          carp "$_[0] and $_[1] are identical";
+          return;
+      }
+   }
+
+   if(-d $_[0] && !$CopyLoop) {
+      $one    = join( '-', ( stat $_[0] )[0,1] ) if !$one;
+      my $abs = File::Spec->rel2abs($_[1]);
+      my @pth = File::Spec->splitdir( $abs );
+      while(@pth) {
+         my $cur = File::Spec->catdir(@pth);
+         last if !$cur; # probably not necessary, but nice to have just in case :)
+         my $two = join( '-', ( stat $cur )[0,1] ) || '';
+         if ( $one eq $two && $one ) {
+             # $! = 62; # Too many levels of symbolic links
+             carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
+             return;
+         }
+      
+         pop @pth;
+      }
+   }
+
+   return 1;
+};
+
+my $glob = sub {
+    my ($do, $src_glob, @args) = @_;
+    
+    local $CPRFComp = 1;
+    
+    my @rt;
+    for my $path ( glob($src_glob) ) {
+        my @call = [$do->($path, @args)] or return;
+        push @rt, \@call;
+    }
+    
+    return @rt;
+};
+
+my $move = sub {
+   my $fl = shift;
+   my @x;
+   if($fl) {
+      @x = fcopy(@_) or return;
+   } else {
+      @x = dircopy(@_) or return;
+   }
+   if(@x) {
+      if($fl) {
+         unlink $_[0] or return;
+      } else {
+         pathrmdir($_[0]) or return;
+      }
+      if($RemvBase) {
+         my ($volm, $path) = File::Spec->splitpath($_[0]);
+         pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
+      }
+   }
+  return wantarray ? @x : $x[0];
+};
+
+my $ok_todo_asper_condcopy = sub {
+    my $org = shift;
+    my $copy = 1;
+    if(exists $CondCopy->{$org}) {
+        if($CondCopy->{$org}{'md5'}) {
+
+        }
+        if($copy) {
+
+        }
+    }
+    return $copy;
+};
+
+sub fcopy { 
+   $samecheck->(@_) or return;
+   if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
+      my $trg = $_[1];
+      if( -d $trg ) {
+        my @trgx = File::Spec->splitpath( $_[0] );
+        $trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
+      }
+      $samecheck->($_[0], $trg) or return;
+      if(-e $trg) {
+         if($RMTrgFil == 1) {
+            unlink $trg or carp "\$RMTrgFil failed: $!";
+         } else {
+            unlink $trg or return;
+         }
+      }
+   }
+   my ($volm, $path) = File::Spec->splitpath($_[1]);
+   if($path && !-d $path) {
+      pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
+   }
+   if( -l $_[0] && $CopyLink ) {
+      carp "Copying a symlink ($_[0]) whose target does not exist" 
+          if !-e readlink($_[0]) && $BdTrgWrn;
+      symlink readlink(shift()), shift() or return;
+   } else {  
+      copy(@_) or return;
+
+      my @base_file = File::Spec->splitpath($_[0]);
+      my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
+
+      chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
+   }
+   return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
+}
+
+sub rcopy { 
+    if (-l $_[0] && $CopyLink) {
+        goto &fcopy;    
+    }
+    
+    goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+    goto &fcopy;
+}
+
+sub rcopy_glob {
+    $glob->(\&rcopy, @_);
+}
+
+sub dircopy {
+   if($RMTrgDir && -d $_[1]) {
+      if($RMTrgDir == 1) {
+         pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
+      } else {
+         pathrmdir($_[1]) or return;
+      }
+   }
+   my $globstar = 0;
+   my $_zero = $_[0];
+   my $_one = $_[1];
+   if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
+       $globstar = 1;
+       $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
+   }
+
+   $samecheck->(  $_zero, $_[1] ) or return;
+   if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
+       $! = 20; 
+       return;
+   } 
+
+   if(!-d $_[1]) {
+      pathmk($_[1], $NoFtlPth) or return;
+   } else {
+      if($CPRFComp && !$globstar) {
+         my @parts = File::Spec->splitdir($_zero);
+         while($parts[ $#parts ] eq '') { pop @parts; }
+         $_one = File::Spec->catdir($_[1], $parts[$#parts]);
+      }
+   }
+   my $baseend = $_one;
+   my $level   = 0;
+   my $filen   = 0;
+   my $dirn    = 0;
+
+   my $recurs; #must be my()ed before sub {} since it calls itself
+   $recurs =  sub {
+      my ($str,$end,$buf) = @_;
+      $filen++ if $end eq $baseend; 
+      $dirn++ if $end eq $baseend;
+      
+      $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+      mkdir($end,$DirPerms) or return if !-d $end;
+      chmod scalar((stat($str))[2]), $end if $KeepMode;
+      if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
+         return ($filen,$dirn,$level) if wantarray;
+         return $filen;
+      }
+      $level++;
+
+      
+      my @files;
+      if ( $] < 5.006 ) {
+          opendir(STR_DH, $str) or return;
+          @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
+          closedir STR_DH;
+      }
+      else {
+          opendir(my $str_dh, $str) or return;
+          @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
+          closedir $str_dh;
+      }
+
+      for my $file (@files) {
+          my ($file_ut) = $file =~ m{ (.*) }xms;
+          my $org = File::Spec->catfile($str, $file_ut);
+          my $new = File::Spec->catfile($end, $file_ut);
+          if( -l $org && $CopyLink ) {
+              carp "Copying a symlink ($org) whose target does not exist" 
+                  if !-e readlink($org) && $BdTrgWrn;
+              symlink readlink($org), $new or return;
+          } 
+          elsif(-d $org) {
+              $recurs->($org,$new,$buf) if defined $buf;
+              $recurs->($org,$new) if !defined $buf;
+              $filen++;
+              $dirn++;
+          } 
+          else {
+              if($ok_todo_asper_condcopy->($org)) {
+                  if($SkipFlop) {
+                      fcopy($org,$new,$buf) or next if defined $buf;
+                      fcopy($org,$new) or next if !defined $buf;                      
+                  }
+                  else {
+                      fcopy($org,$new,$buf) or return if defined $buf;
+                      fcopy($org,$new) or return if !defined $buf;
+                  }
+                  chmod scalar((stat($org))[2]), $new if $KeepMode;
+                  $filen++;
+              }
+          }
+      }
+      1;
+   };
+
+   $recurs->($_zero, $_one, $_[2]) or return;
+   return wantarray ? ($filen,$dirn,$level) : $filen;
+}
+
+sub fmove { $move->(1, @_) } 
+
+sub rmove { 
+    if (-l $_[0] && $CopyLink) {
+        goto &fmove;    
+    }
+    
+    goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+    goto &fmove;
+}
+
+sub rmove_glob {
+    $glob->(\&rmove, @_);
+}
+
+sub dirmove { $move->(0, @_) }
+
+sub pathmk {
+   my @parts = File::Spec->splitdir( shift() );
+   my $nofatal = shift;
+   my $pth = $parts[0];
+   my $zer = 0;
+   if(!$pth) {
+      $pth = File::Spec->catdir($parts[0],$parts[1]);
+      $zer = 1;
+   }
+   for($zer..$#parts) {
+      $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+      mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal;
+      mkdir($pth,$DirPerms) if !-d $pth && $nofatal;
+      $pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
+   }
+   1;
+} 
+
+sub pathempty {
+   my $pth = shift; 
+
+   return 2 if !-d $pth;
+
+   my @names;
+   my $pth_dh;
+   if ( $] < 5.006 ) {
+       opendir(PTH_DH, $pth) or return;
+       @names = grep !/^\.+$/, readdir(PTH_DH);
+   }
+   else {
+       opendir($pth_dh, $pth) or return;
+       @names = grep !/^\.+$/, readdir($pth_dh);       
+   }
+   
+   for my $name (@names) {
+      my ($name_ut) = $name =~ m{ (.*) }xms;
+      my $flpth     = File::Spec->catdir($pth, $name_ut);
+
+      if( -l $flpth ) {
+	      unlink $flpth or return; 
+      }
+      elsif(-d $flpth) {
+          pathrmdir($flpth) or return;
+      } 
+      else {
+          unlink $flpth or return;
+      }
+   }
+
+   if ( $] < 5.006 ) {
+       closedir PTH_DH;
+   }
+   else {
+       closedir $pth_dh;
+   }
+   
+   1;
+}
+
+sub pathrm {
+   my $path = shift;
+   return 2 if !-d $path;
+   my @pth = File::Spec->splitdir( $path );
+   my $force = shift;
+
+   while(@pth) { 
+      my $cur = File::Spec->catdir(@pth);
+      last if !$cur; # necessary ??? 
+      if(!shift()) {
+         pathempty($cur) or return if $force;
+         rmdir $cur or return;
+      } 
+      else {
+         pathempty($cur) if $force;
+         rmdir $cur;
+      }
+      pop @pth;
+   }
+   1;
+}
+
+sub pathrmdir {
+    my $dir = shift;
+    if( -e $dir ) {
+        return if !-d $dir;
+    }
+    else {
+        return 2;
+    }
+
+    pathempty($dir) or return;
+    
+    rmdir $dir or return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy::Recursive - Perl extension for recursively copying files and directories
+
+=head1 SYNOPSIS
+
+  use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
+
+  fcopy($orig,$new[,$buf]) or die $!;
+  rcopy($orig,$new[,$buf]) or die $!;
+  dircopy($orig,$new[,$buf]) or die $!;
+
+  fmove($orig,$new[,$buf]) or die $!;
+  rmove($orig,$new[,$buf]) or die $!;
+  dirmove($orig,$new[,$buf]) or die $!;
+  
+  rcopy_glob("orig/stuff-*", $trg [, $buf]) or die $!;
+  rmove_glob("orig/stuff-*", $trg [,$buf]) or die $!;
+
+=head1 DESCRIPTION
+
+This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's mode.
+
+=head1 EXPORT
+
+None by default. But you can export all the functions as in the example above and the path* functions if you wish.
+
+=head2 fcopy()
+
+This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
+One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
+The optional $buf in the synopsis if the same as File::Copy::copy()'s 3rd argument
+returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomidate rcopy()'s list context on regular files. (See below for more info)
+
+=head2 dircopy()
+
+This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
+$new is created if necessary (multiple non existant directories is ok (IE foo/bar/baz). The script logically and portably creates all of them if necessary).
+It attempts to preserve the mode (see Preserving Mode below) and 
+by default it copies all the way down into the directory, (see Managing Depth) below.
+If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
+
+returns true or false, for true in scalar context it returns the number of files and directories copied,
+In list context it returns the number of files and directories, number of directories only, depth level traversed.
+
+  my $num_of_files_and_dirs = dircopy($orig,$new);
+  my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
+  
+Normally it stops and return's if a copy fails, to continue on regardless set $File::Copy::Recursive::SkipFlop to true.
+
+    local $File::Copy::Recursive::SkipFlop = 1;
+
+That way it will copy everythgingit can ina directory and won't stop because of permissions, etc...
+
+=head2 rcopy()
+
+This function will allow you to specify a file *or* directory. It calls fcopy() if its a file and dircopy() if its a directory.
+If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used. 
+This is important becasue if its a directory in list context and there is only the initial directory the return value is 1,1,1.
+
+=head2 rcopy_glob()
+
+This function lets you specify a pattern suitable for perl's glob() as the first argument. Subsequently each path returned by perl's glob() gets rcopy()ied.
+
+It returns and array whose items are array refs that contain the return value of each rcopy() call.
+
+It forces behavior as if $File::Copy::Recursive::CPRFComp is true.
+
+=head2 fmove()
+
+Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
+
+=head2 dirmove()
+
+Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
+
+=head2 rmove()
+
+Like rcopy() but calls fmove() or dirmove() instead.
+
+=head2 rmove_glob()
+
+Like rcopy_glob() but calls rmove() instead of rcopy()
+
+=head3 $RemvBase
+
+Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
+
+So if you:
+
+   rmove('foo/bar/baz', '/etc/');
+   # "baz" is removed from foo/bar after it is successfully copied to /etc/
+   
+   local $File::Copy::Recursive::Remvbase = 1;
+   rmove('foo/bar/baz','/etc/');
+   # if baz is successfully copied to /etc/ :
+   # first "baz" is removed from foo/bar
+   # then "foo/bar is removed via pathrm()
+
+=head4 $ForcePth
+
+Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in effect.
+
+=head2 Creating and Removing Paths
+
+=head3 $NoFtlPth
+
+Default is false. If set to true  rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
+
+If its set to true they just silently go about their business regardless. This isn't a good idea but its there if you want it.
+
+=head3 $DirPerms
+
+Mode to pass to any mkdir() calls. Defaults to 0777 as per umask()'s POD. Explicitly having this allows older perls to be able to use FCR and might add a bit of flexibility for you.
+
+Any value you set it to should be suitable for oct()
+
+=head3 Path functions
+
+These functions exist soley because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the purpose of this module. That being said, here is how they work so you can understand how the copy and move funtions work and use them by themselves if you wish.
+
+=head4 pathrm()
+
+Removes a given path recursively. It removes the *entire* path so be carefull!!!
+
+Returns 2 if the given path is not a directory.
+
+  File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
+  # foo no longer exists
+
+Same as:
+
+  rmdir 'foo/bar/baz' or die $!;
+  rmdir 'foo/bar' or die $!;
+  rmdir 'foo' or die $!;
+
+An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
+
+  File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
+  # foo no longer exists
+
+Same as:PFSCheck
+
+  File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
+  rmdir 'foo/bar/baz' or die $!;
+  File::Copy::Recursive::pathempty('foo/bar/') or die $!;
+  rmdir 'foo/bar' or die $!;
+  File::Copy::Recursive::pathempty('foo/') or die $!;
+  rmdir 'foo' or die $!;
+
+An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
+
+=head4 pathempty()
+
+Recursively removes the given directory's contents so it is empty. returns 2 if argument is not a directory, 1 on successfully emptying the directory.
+
+   File::Copy::Recursive::pathempty($pth) or die $!;
+   # $pth is now an empty directory
+
+=head4 pathmk()
+
+Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
+
+   File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
+
+An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again, probably a *bad* idea.
+
+=head4 pathrmdir()
+
+Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
+Just removes the top directory the path given instead of the entire path like pathrm(). Return 2 if given argument does not exist (IE its already gone). Return false if it exists but is not a directory.
+
+=head2 Preserving Mode
+
+By default a quiet attempt is made to change the new file or directory to the mode of the old one.
+To turn this behavior off set
+  $File::Copy::Recursive::KeepMode
+to false;
+
+=head2 Managing Depth
+
+You can set the maximum depth a directory structure is recursed by setting:
+  $File::Copy::Recursive::MaxDepth 
+to a whole number greater than 0.
+
+=head2 SymLinks
+
+If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
+Perl's symlink() is used instead of File::Copy's copy()
+You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
+It is already set to true or false dending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
+
+    if($File::Copy::Recursive::CopyLink) {
+        print "Symlinks will be preserved\n";
+    } else {
+        print "Symlinks will not be preserved because your system does not support it\n";
+    }
+
+If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. Its false by default.
+
+    local $File::Copy::Recursive::BdTrgWrn  = 1;
+
+=head2 Removing existing target file or directory before copying.
+
+This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
+
+0 = off (This is the default)
+
+1 = carp() $! if removal fails
+
+2 = return if removal fails
+
+    local $File::Copy::Recursive::RMTrgFil = 1;
+    fcopy($orig, $target) or die $!;
+    # if it fails it does warn() and keeps going
+
+    local $File::Copy::Recursive::RMTrgDir = 2;
+    dircopy($orig, $target) or die $!;
+    # if it fails it does your "or die"
+
+This should be unnecessary most of the time but its there if you need it :)
+
+=head2 Turning off stat() check
+
+By default the files or directories are checked to see if they are the same (IE linked, or two paths (absolute/relative or different relative paths) to the same file) by comparing the file's stat() info. 
+It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck to a false value. ("PFS" stands for "Physical File System")
+
+=head2 Emulating cp -rf dir1/ dir2/
+
+By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
+
+You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
+
+NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
+If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
+
+That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
+If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf)
+
+So assuming 'foo/file':
+
+    dircopy('foo', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+    $File::Copy::Recursive::CPRFComp = 1;
+    dircopy('foo', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/foo/file
+
+You can also specify a star for cp -rf glob type behavior:
+
+    dircopy('foo/*', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+    $File::Copy::Recursive::CPRFComp = 1;
+    dircopy('foo/*', 'bar') or die $!;
+    # if bar does not exist the result is bar/file
+    # if bar does exist the result is bar/file
+
+NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (IE not like cp -rf fo* to copy foo/*)
+
+=head2 Allowing Copy Loops
+
+If you want to allow:
+
+  cp -rf . foo/
+
+type behavior set $File::Copy::Recursive::CopyLoop to true.
+
+This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
+
+If you ever find a situation where $CopyLoop = 1 is desirable let me know (IE its a bad bad idea but is there if you want it)
+
+(Note: On Windows this was necessary since it uses stat() to detemine samedness and stat() is essencially useless for this on Windows. 
+The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
+
+=head1 SEE ALSO
+
+L<File::Copy> L<File::Spec>
+
+=head1 TO DO
+
+I am currently working on and reviewing some other modules to use in the new interface so we can lose the horrid globals as well as some other undesirable traits and also more easily make available some long standing requests.
+
+Tests will be easier to do with the new interface and hence the testing focus will shift to the new interface and aim to be comprehensive.
+
+The old interface will work, it just won't be brought in until it is used, so it will add no overhead for users of the new interface.
+
+I'll add this after the latest verision has been out for a while with no new features or issues found :)
+
+=head1 AUTHOR
+
+Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Muey
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut

+ 45 - 0
File/README

@@ -0,0 +1,45 @@
+File/Copy/Recursive version 0.38
+================================
+
+This module has 3 functions, one to copy files only, one to copy directories 
+only and one to do either depending on the argument's type.
+
+The depth to which a directory structure is copied can be set with:
+
+ $File::Copy::Recursive::Maxdepth
+
+setting it back to false or non numeric value will turn it back to unlimited.
+
+All functions attempt to preserve each copied file's mode unless you set
+ $File::Copy::Recursive::KeepMode
+to false.
+
+See
+ perldoc File::Copy::Recursive
+for more info
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+or
+ perl -MCPAN -e 'install File::Copy::Recursive;'
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ File::Copy
+ File::Spec
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 Daniel Muey
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 

+ 15 - 0
File/Rsync/Config.pm

@@ -0,0 +1,15 @@
+# -*- perl -*-
+# vim:ft=perl foldlevel=1
+package File::Rsync::Config;
+
+require Exporter;
+use vars qw(@ISA @EXPORT %RsyncConfig);
+use strict;
+
+@EXPORT=qw(%RsyncConfig);
+@ISA=qw(Exporter);
+
+%RsyncConfig=(
+      rsync_path => '/usr/bin/rsync',
+);
+1;

+ 912 - 0
File/Rsync/Rsync.pm

@@ -0,0 +1,912 @@
+# -*- perl -*-
+# vim:ft=perl foldlevel=1
+#      __
+#     /\ \ From the mind of
+#    /  \ \
+#   / /\ \ \_____ Lee Eakin  ( Leakin at dfw dot Nostrum dot com )
+#  /  \ \ \______\       or  ( Leakin at cpan dot org )
+# / /\ \ \/____  /       or  ( Leakin at japh dot net )
+# \ \ \ \____\/ /        or  ( Lee at Eakin dot Org )
+#  \ \ \/____  /  Wrapper module for the rsync program
+#   \ \____\/ /   rsync can be found at http://rsync.samba.org/rsync/
+#    \/______/
+
+package File::Rsync;
+require 5.004; # it might work with older versions of 5 but not tested
+
+use FileHandle;
+use IPC::Open3 qw(open3);
+use IO::Select;
+use POSIX ":sys_wait_h";
+use Carp 'carp';
+use File::Rsync::Config;
+use Scalar::Util qw(blessed);
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.43';
+
+=head1 NAME
+
+File::Rsync - perl module interface to rsync(1) F<http://rsync.samba.org/rsync/>
+
+=head1 SYNOPSIS
+
+use File::Rsync;
+
+$obj = File::Rsync->new( { archive => 1, compress => 1,
+         rsh => '/usr/local/bin/ssh',
+         'rsync-path' => '/usr/local/bin/rsync' } );
+
+$obj->exec( { src => 'localdir', dest => 'rhost:remdir' } )
+         or warn "rsync failed\n";
+
+=head1 DESCRIPTION
+
+Perl Convenience wrapper for the rsync(1) program.  Written for I<rsync-2.3.2>
+and updated for I<rsync-2.6.0> but should perform properly with most recent
+versions.
+
+=over 4
+
+=item File::Rsync::new
+
+$obj = I<new> File::Rsync;
+
+   or
+
+$obj = File::Rsync->I<new>;
+
+   or
+
+$obj = File::Rsync->new(@options);
+
+   or
+
+$obj = File::Rsync->new(\%options);
+
+Create a I<File::Rsync> object.  Any options passed at creation are stored
+in the object as defaults for all future I<exec> calls on that object.
+Options may be passed in the form of a hash and are the same as the long
+options in I<rsync(1)> with the leading double-dash removed.  An additional
+option of B<path-to-rsync> also exists which can be used to override the
+hardcoded path to the rsync binary that is defined when the module is
+installed, and B<debug> which causes the module methods to print some
+debugging information to STDERR.  There are also 2 options to wrap the
+source and/or destination paths in double-quotes.  They are B<quote-src>
+and B<quote-dst>, and may be useful in protecting the paths from shell
+expansion (particularly useful for paths containing spaces).  The
+B<outfun> and B<errfun> options take a function reference.  The function
+is called once for each line of output from the I<rsync> program with the
+output line passed in as the first argument, the second arg is either
+'out' or 'err' depending on the source.  This makes it possible to use the
+same function for both and still determine where the output came from.
+Options may also be passed as a reference to a hash.  The B<exclude>
+option needs an array reference as its value, since there cannot be
+duplicate keys in a hash.  There is an equivalent B<include> option.  Only
+an B<exclude> or B<include> option should be used, not both.  Use the '+ '
+or '- ' prefix trick to put includes in an B<exclude> array, or to put
+excludes in an B<include> array (see I<rsync(1)> for details).
+Include/exclude options form an ordered list.  The order must be retained
+for proper execution.  There are also B<source> and B<dest> keys.  The key
+B<src> is also accepted as an equivalent to B<source>, and B<dst> or
+B<destination> may be used as equivalents to B<dest>.  The B<source>
+option may take a scalar or an array reference.  If the source is the
+local system then multiple B<source> paths are allowed.  In this case an
+array reference should be used.  There is also a method for passing
+multiple source paths to a remote system.  This method may be triggered in
+this module by passing the remote hostname to the B<srchost> key and
+passing an array reference to the B<source> key.  If the source host is
+being accessed via an Rsync server, the remote hostname should have a
+single trailing colon on the name.  When rsync is called, the B<srchost>
+value and the values in the B<source> array will be joined with a colon
+resulting in the double-colon required for server access.  The B<dest> key
+only takes a scalar since I<rsync> only accepts a single destination path.
+
+Version 2.6.0 of I<rsync(1)> provides a new B<files-from> option along with
+a few other supporting options (B<from0>, B<no-relative>, and
+B<no-implied-dirs>).  To support this wonderful new option at the level it
+deserves, this module now has an additional parameter.  If B<files-from> is
+set to '-' (meaning read from stdin) you can define B<infun> to be a
+reference to a function that prints your file list to the default file handle.
+The output from the function is attached to stdin of the rsync call during
+exec.  If B<infun> is defined it will be called regardless of the value of
+B<files-from>, so it can provide any data expected on stdin, but keep in mind
+that stdin will not be attached to a tty so it is not very useful for sending
+passwords (see the I<rsync(1)> and I<ssh(1)> man pages for ways to handle
+authentication).  The I<rsync(1)> man page has a more complete description of
+B<files-from>.  Also see L<File::Find> for ideas to use with B<files-from>
+and B<infun>.  The B<infun> option may also be used with the B<include-from>
+or B<exclude-from> settings, but this is generally more clumsy than using the
+B<include> or B<exclude> arrays.
+
+Version 2.6.3 of I<rsync(1)> provides new options B<partial-dir>,
+B<checksum-seed>, B<keep-dirlinks>, B<inplace>, B<ipv4>, and B<ipv6>.
+Version 2.6.4 of I<rsync(1)> provides new options B<del>, B<delete-before>
+B<delete-during>, B<delay-updates>, B<dirs>, B<filter>, B<fuzzy>,
+B<itemize-changes>, B<list-only>, B<omit-dir-times>, B<remove-sent-files>,
+B<max-size>, and B<protocol>.
+
+Version 0.38 of this module also adds support for the B<acls> option that
+is not part of I<rsync(1)> unless the patch has been applied, but people do
+use it.  It also includes a new B<literal> option that takes an array reference
+similar to B<include>, B<exclude>, and B<filter>.  Any arguments in the array
+are passed as literal arguments to rsync, and are passed first.  They should
+have the proper single or double hyphen prefixes and the elements should be
+split up the way you want them passed to exec.  The purpose of this option
+is to allow the use of arbitrary options added by patches, and/or to allow
+the use of new options in rsync without needing an imediate update to the
+module in addtition to I<rsync(1)> itself.
+
+=back
+
+=cut
+
+sub new {
+   my $class = shift;
+
+   # seed the options hash, booleans, scalars, excludes, source, dest, data,
+   # status, stderr/stdout storage for last exec
+   my $self = {
+      # the full path name to the rsync binary
+      'path-to-rsync' => $RsyncConfig{rsync_path},
+      # these are the boolean flags to rsync, all default off, including them
+      # in the args list turns them on
+      'flag' => {qw(
+         8-bit-output         0  fuzzy                0  no-specials          0
+         acls                 0  group                0  no-super             0
+         append               0  hard-links           0  no-times             0
+         archive              0  help                 0  no-whole-file        0
+         backup               0  ignore-errors        0  numeric-ids          0
+         blocking-io          0  ignore-existing      0  omit-dir-times       0
+         checksum             0  ignore-non-existing  0  one-file-system      0
+         compress             0  ignore-times         0  whole-file           0
+         copy-dirlinks        0  inplace              0  owner                0
+         copy-links           0  ipv4                 0  partial              0
+         copy-unsafe-links    0  ipv6                 0  perms                0
+         cvs-exclude          0  keep-dirlinks        0  progress             0
+         daemon               0  links                0  prune-empty-dirs     0
+         del                  0  list-only            0  recursive            0
+         delay-updates        0  no-blocking-io       0  relative             0
+         delete               0  no-detach            0  remove-sent-files    0
+         delete-after         0  no-devices           0  safe-links           0
+         delete-before        0  no-dirs              0  size-only            0
+         delete-during        0  no-groups            0  sparse               0
+         delete-excluded      0  no-implied-dirs      0  specials             0
+         devices              0  no-links             0  stats                0
+         dirs                 0  no-owner             0  super                0
+         dry-run              0  no-partial           0  times                0
+         executability        0  no-perms             0  update               0
+         existing             0  no-progress          0  version              0
+         force                0  no-recursive         0  xattrs               0
+         from0                0  no-relative          0  
+      )},
+      # these have simple scalar args we cannot easily check
+      'scalar' => {qw(
+         address              0  log-format           0  protocol             0
+         backup-dir           0  max-delete           0  read-batch           0
+         block-size           0  max-size             0  rsh                  0
+         bwlimit              0  min-size             0  rsync-path           0
+         checksum-seed        0  modify-window        0  sockopts             0
+         compress-level       0  only-write-batch     0  suffix               0
+         config               0  partial-dir          0  temp-dir             0
+         csum-length          0  password-file        0  timeout              0
+         files-from           0  port                 0  write-batch          0
+      )},
+      # these are not flags but counters, each time they appear it raises the
+      # count, so we keep track and pass them the same number of times
+      'counter' => {qw(
+         human-readable       0  one-file-system      0  verbose              0
+         itemize-changes      0  quiet                0
+      )},
+      # these can be specified multiple times and are additive, the doc also
+      # specifies that it is an ordered list so we must preserve that order
+      'chmod'        => [],
+      'compare-dest' => [],
+      'copy-dest'    => [],
+      'exclude'      => [],
+      'exclude-from' => [],
+      'filter'       => [],
+      'include'      => [],
+      'include-from' => [],
+      'link-dest'    => [],
+      'literal'      => [],
+      # hostname of source, used if 'source' is an array reference
+      'srchost'     => '',
+      # source host and/or path names
+      'source'      => '',
+      # destination host and/or path
+      'dest'        => '',
+      # return status from last exec
+      'status'      => 0,
+      'realstatus'  => 0,
+      # last rsync command-line executed
+      'lastcmd'     => undef,
+      # whether or not to print debug statements
+      'debug'       => 0,
+      # double-quote source and/or destination paths
+      'quote-src'   => 0,
+      'quote-dst'   => 0,
+      # stderr from last exec in array format (messages from remote rsync proc)
+      'err'         => 0,
+      'errfun'      => undef,
+      # stdout from last exec in array format (messages from local rsync proc)
+      'out'         => 0,
+      'outfun'      => undef,
+      # function to prvide --*-from=- data via pipe
+      'infun'     => undef,
+      # this flag changes error checking in 'exec' when called by 'list'
+      'list'        => 0,
+   };
+   bless $self, $class; # bless it first so defopts can find out the class
+   if (@_) {
+      &defopts($self,@_) or return;
+   }
+   return $self;
+}
+
+=over 4
+
+=item File::Rsync::defopts
+
+$obj->defopts(@options);
+
+   or
+
+$obj->defopts(\%options);
+
+Set default options for future exec calls for the object.  See I<rsync(1)>
+for a complete list of valid options.  This is really the internal
+method that I<new> calls but you can use it too.  The B<verbose> and B<quiet>
+options to rsync are actually counters.  When assigning the perl hash-style
+options you may specify the counter value directly and the module will pass
+the proper number of options to rsync.
+
+=back
+
+=cut
+
+sub defopts {
+   # this method has now been split into 2 sub methods (parse and save)
+   # _saveopts and _parseopts should only be used via defopts or exec
+   my $self = shift;
+   &_saveopts($self,&_parseopts($self,@_));
+}
+
+sub _parseopts {
+   # this method checks and converts it's args into a reference to a hash
+   # of valid options and returns it to the caller
+   my $self = shift;
+   my $pkgname = ref $self;
+   my @opts = @_;
+   my $opt;
+   my %OPT = (); # this is the hash we will return a ref to
+
+   # make sure we are passed the proper number of args
+   if (@opts == 1) {
+      $opt = shift;
+      if (my $reftype = ref $opt) {
+         unless ($reftype eq 'HASH') {
+            carp "$pkgname: invalid reference type ($reftype) in options";
+            return;
+         }
+      } else {
+         carp "$pkgname: invalid option ($opt)";
+         return;
+      }
+   } elsif (@opts % 2) {
+      carp "$pkgname: invalid number of options passed (must be key/value pairs)";
+      return;
+   } else {
+      $opt = {@opts};
+   }
+
+   # now process the options given, we handle debug first since hashes do not
+   # have a specific order, and it would not be set first even if we sorted
+   if (exists $opt->{'debug'}) {
+      $OPT{'debug'} = $opt->{'debug'};
+      print(STDERR "setting debug flag\n") if $OPT{'debug'};
+   }
+   foreach my $hashopt (keys %$opt) {
+      my $savopt = $hashopt;
+      $savopt =~ tr/_/-/;
+      next if $hashopt eq 'debug'; # we did this one first (above)
+      print STDERR "processing option: $hashopt\n"
+         if $OPT{'debug'} or $self->{'debug'};
+      if (exists $self->{'flag'}{$savopt}
+            or exists $self->{'scalar'}{$savopt}
+            or exists $self->{'counter'}{$savopt}) {
+         $OPT{$savopt} = $opt->{$hashopt};
+      } else {
+         my $tag = '';
+         if (     $hashopt eq 'chmod'
+               or $hashopt eq 'compare-dest'
+               or $hashopt eq 'copy-dest'
+               or $hashopt eq 'exclude'
+               or $hashopt eq 'exclude-from'
+               or $hashopt eq 'filter'
+               or $hashopt eq 'include'
+               or $hashopt eq 'include-from'
+               or $hashopt eq 'link-dest'
+               or $hashopt eq 'literal') {
+            $tag = $hashopt;
+         } elsif ($hashopt eq 'source'
+               or $hashopt eq 'src') {
+            $tag = 'source';
+         }
+         if ($tag) {
+            if (my $reftype = ref $opt->{$hashopt}) {
+               if ($reftype eq 'ARRAY') {
+                  $OPT{$tag} = $opt->{$hashopt};
+               } elsif ($tag eq 'source' && blessed $opt->{$hashopt}) {
+                  $OPT{$tag} = [ $opt->{$hashopt} ];
+               } else {
+                  carp "$pkgname: invalid reference type for $hashopt option";
+                  return;
+               }
+            } elsif ($tag eq 'source') {
+               $OPT{$tag} = [ $opt->{$hashopt} ];
+            } else {
+               carp "$pkgname: $hashopt is not a reference";
+               return;
+            }
+         } elsif ($hashopt eq 'dest'
+               or $hashopt eq 'destination'
+               or $hashopt eq 'dst') {
+            $OPT{'dest'} = $opt->{$hashopt};
+
+         } elsif ($savopt eq 'path-to-rsync'
+               or $savopt eq 'srchost'
+               or $savopt eq 'quote-dst'
+               or $savopt eq 'quote-src') {
+            $OPT{$savopt} = $opt->{$hashopt};
+         } elsif ($hashopt eq 'outfun' or $hashopt eq 'errfun'
+               or $hashopt eq 'infun') {
+            if (ref $opt->{$hashopt} eq 'CODE') {
+               $OPT{$hashopt} = $opt->{$hashopt};
+            } else {
+               carp "$pkgname: $hashopt option is not a function reference";
+               return;
+            }
+         } else {
+            carp "$pkgname: $hashopt - unknown option";
+            return;
+         }
+      }
+   }
+   return \%OPT;
+}
+
+sub _saveopts {
+   # this method saves the data from the hash passed to it in the object's
+   # hash
+   my $self = shift;
+   my $pkgname = ref $self;
+   my $opts = shift;
+   return unless ref $opts eq 'HASH';
+   foreach my $opt (keys %$opts) {
+      if (exists $self->{'flag'}{$opt}) {
+         $self->{'flag'}{$opt} = $opts->{$opt};
+      } elsif (exists $self->{'scalar'}{$opt}) {
+         $self->{'scalar'}{$opt} = $opts->{$opt};
+      } elsif (exists $self->{'counter'}{$opt}) {
+         $self->{'counter'}{$opt} = $opts->{$opt};
+      } elsif ($opt eq 'chmod' or $opt eq 'compare-dest'
+            or $opt eq 'copy-dest' or $opt eq 'link-dest'
+            or $opt eq 'exclude' or $opt eq 'exclude-from'
+            or $opt eq 'include' or $opt eq 'include-from'
+            or $opt eq 'filter' or $opt eq 'source' or $opt eq 'dest'
+            or $opt eq 'debug' or $opt eq 'outfun' or $opt eq 'errfun'
+            or $opt eq 'infun' or $opt eq 'path-to-rsync'
+            or $opt eq 'srchost' or $opt eq 'quote-dst'
+            or $opt eq 'quote-src' or $opt eq 'literal') {
+         $self->{$opt} = $opts->{$opt};
+      } else {
+         carp "$pkgname: unknown option: $opt";
+         return;
+      }
+   }
+   return 1;
+}
+
+=over 4
+
+=item File::Rsync::getcmd
+
+my $cmd = $obj->getcmd(@options);
+
+   or
+
+my $cmd = $obj->getcmd(\%options);
+
+   or
+
+my ($cmd, $infun, $outfun, $errfun, $debug) = $obj->getcmd(\%options);
+
+I<getcmd> returns a reference to an array containing the real rsync command
+that would be called if the exec function were called.  The last example above
+includes a reference to the optional stdin function, stdout function, stderr
+function, and the debug setting.  This is the form used by the I<exec> method
+to get the extra parameters it needs to do its job.  The function is exposed
+to allow a user-defined exec function to be used, or for debugging purposes.
+
+=back
+
+=cut
+
+sub getcmd {
+   my $self = shift;
+   my $pkgname = ref $self;
+   my $merged = $self;
+   my $list = $self->{list};
+   $self->{list} = 0 if $self->{list};
+   if (@_) { # If args are passed to exec then we have to merge the saved
+      # (default) options with those passed, for any conflicts those passed
+      # directly to exec take precidence
+      my $execopts = &_parseopts($self,@_);
+      return unless ref $execopts eq 'HASH';
+      my %runopts = ();
+      # first copy the default info from $self
+      foreach my $type (qw(flag scalar counter)) {
+         foreach my $opt (keys %{$self->{$type}}) {
+            $runopts{$type}{$opt} = $self->{$type}{$opt};
+         }
+      }
+      foreach my $opt (qw(path-to-rsync chmod compare-dest copy-dest
+               exclude exclude-from filter include include-from
+               link-dest source srchost debug dest outfun
+               errfun infun quote-dst quote-src literal)) {
+         $runopts{$opt} = $self->{$opt};
+      }
+      # now allow any args passed directly to exec to override
+      foreach my $opt (keys %$execopts) {
+         if (exists $runopts{'flag'}{$opt}) {
+            $runopts{'flag'}{$opt} = $execopts->{$opt};
+         } elsif (exists $runopts{'scalar'}{$opt}) {
+            $runopts{'scalar'}{$opt} = $execopts->{$opt};
+         } elsif (exists $runopts{'counter'}{$opt}) {
+            $runopts{'counter'}{$opt} = $execopts->{$opt};
+         } elsif ($opt eq 'chmod' or $opt eq 'compare-dest'
+               or $opt eq 'copy-dest' or $opt eq 'link-dest'
+               or $opt eq 'exclude' or $opt eq 'exclude-from'
+               or $opt eq 'include' or $opt eq 'include-from'
+               or $opt eq 'filter' or $opt eq 'source' or $opt eq 'dest'
+               or $opt eq 'debug' or $opt eq 'outfun' or $opt eq 'errfun'
+               or $opt eq 'infun' or $opt eq 'path-to-rsync'
+               or $opt eq 'srchost' or $opt eq 'quote-dst'
+               or $opt eq 'quote-src' or $opt eq 'literal') {
+            $runopts{$opt} = $execopts->{$opt};
+         } else {
+            carp "$pkgname: unknown option: $opt";
+            return;
+         }
+      }
+      $merged = \%runopts;
+   }
+
+   my @cmd = ($merged->{'path-to-rsync'});
+
+   # put any literal options first
+   push @cmd,@{$merged->{'literal'}} if @{$merged->{'literal'}};
+
+   foreach my $opt (sort keys %{$merged->{'flag'}}) {
+      push @cmd,"--$opt" if $merged->{'flag'}{$opt};
+   }
+   foreach my $opt (sort keys %{$merged->{'scalar'}}) {
+      push @cmd,"--$opt=$merged->{'scalar'}{$opt}" if $merged->{'scalar'}{$opt};
+   }
+   foreach my $opt (sort keys %{$merged->{'counter'}}) {
+      for (my $i = 0;$i<$merged->{'counter'}{$opt};$i++) {
+         push @cmd,"--$opt";
+      }
+   }
+   if ((@{$merged->{'exclude'}} != 0) + (@{$merged->{'include'}} != 0)
+           + (@{$merged->{'filter'}} != 0) > 1) {
+      carp "$pkgname: 'exclude' and/or 'include' and/or 'filter' options specified, only one allowed";
+      return;
+   }
+   foreach my $opt (@{$merged->{'chmod'}}) {
+      push @cmd,"--chmod=$opt";
+   }
+   foreach my $opt (@{$merged->{'compare-dest'}}) {
+      push @cmd,"--compare-dest=$opt";
+   }
+   foreach my $opt (@{$merged->{'copy-dest'}}) {
+      push @cmd,"--copy-dest=$opt";
+   }
+   foreach my $opt (@{$merged->{'exclude'}}) {
+      push @cmd,"--exclude=$opt";
+   }
+   foreach my $opt (@{$merged->{'exclude-from'}}) {
+      push @cmd,"--exclude-from=$opt";
+   }
+   foreach my $opt (@{$merged->{'filter'}}) {
+      push @cmd,"--filter=$opt";
+   }
+   foreach my $opt (@{$merged->{'include'}}) {
+      push @cmd,"--include=$opt";
+   }
+   foreach my $opt (@{$merged->{'include-from'}}) {
+      push @cmd,"--include-from=$opt";
+   }
+   foreach my $opt (@{$merged->{'link-dest'}}) {
+      push @cmd,"--link-dest=$opt";
+   }
+   if ($merged->{'source'}) {
+      if ($merged->{'srchost'}) {
+         push @cmd, "$merged->{'srchost'}:" . join ' ',
+            $merged->{'quote-src'} ? map { "\"$_\"" } @{$merged->{'source'}}
+                                    : @{$merged->{'source'}};
+      } else {
+         push @cmd,
+            $merged->{'quote-src'} ? map { "\"$_\"" } @{$merged->{'source'}}
+                                    : @{$merged->{'source'}};
+      }
+   } elsif ($merged->{'srchost'} and $list) {
+      push @cmd, "$merged->{'srchost'}:";
+   } else {
+      if ($list) {
+         carp "$pkgname: no 'source' specified";
+         return;
+      } elsif ($merged->{'dest'}) {
+         carp "$pkgname: option 'dest' specified without 'source' option";
+         return;
+      } else {
+         carp "$pkgname: no source or destination specified";
+         return;
+      }
+   }
+   unless ($list) {
+      if ($merged->{'dest'}) {
+         push @cmd,
+            $merged->{'quote-dst'} ? "\"$merged->{'dest'}\""
+                                   : $merged->{'dest'};
+      } else {
+         carp "$pkgname: option 'source' specified without 'dest' option";
+         return;
+      }
+   }
+   return(wantarray
+         ? (\@cmd,
+            $merged->{'infun'},
+            $merged->{'outfun'},
+            $merged->{'errfun'},
+            $merged->{'debug'})
+         : \@cmd);
+}
+
+=over 4
+
+=item File::Rsync::exec
+
+$obj->exec(@options) or warn "rsync failed\n";
+
+   or
+
+$obj->exec(\%options) or warn "rsync failed\n";
+
+This is the method that does the real work.  Any options passed to this
+routine are appended to any pre-set options and are not saved.  They effect
+the current execution of I<rsync> only.  In the case of conflicts, the options
+passed directly to I<exec> take precedence.  It returns B<1> if the return
+status was zero (or true), if the I<rsync> return status was non-zero it
+returns B<0> and stores the return status.  You can examine the return status
+from I<rsync> and any output to stdout and stderr with the methods listed below.
+
+=back
+
+=cut
+
+sub exec {
+   my $self = shift;
+
+   my ($cmd, $infun, $outfun, $errfun, $debug) = $self->getcmd(@_);
+   return unless $cmd;
+   print STDERR "exec: @$cmd\n" if $debug;
+   my $out = FileHandle->new; my $err = FileHandle->new;
+   $err->autoflush(1);
+   $out->autoflush(1);
+   local $SIG{CHLD}='DEFAULT';
+   my $pid;
+   {
+      my $in = FileHandle->new;
+      $in->autoflush(1);
+      $pid = eval{ open3 $in,$out,$err,@$cmd };
+      $self->{lastcmd} = $cmd;
+      if ($@) {
+         $self->{'realstatus'} = 0;
+         $self->{'status'} = 255;
+         $self->{'err'} = [$@,"Execution of rsync failed.\n"];
+         return 0;
+      }
+      if ($infun) {
+         select((select($in),&{$infun})[0]);
+      }
+      $in->close;
+   }
+   my $odata = my $edata = '';
+
+   my $stream = { 
+     $out->fileno => {
+        name         => 'out',
+        data         => \$odata,
+        buffer_tail  => '',
+        block_size   => ($out->stat)[11] || 1024,
+        handler      => $outfun
+     },         
+     $err->fileno => {
+        name         => 'err',
+        data         => \$edata,
+        buffer_tail  => '',
+        block_size   => ($err->stat)[11] || 1024,
+        handler      => $errfun
+     }
+   };
+
+   my $select = IO::Select->new;
+   $select->add($out,$err);
+
+   while ($out->opened or $err->opened) {
+      foreach my $fd ( $select->can_read(1) ) {
+         my $str = $stream->{$fd->fileno};
+         warn("stream not found") unless $str;
+
+         my $buffer;
+         if ( $fd->sysread($buffer, $str->{block_size}) ) {
+            ${$str->{data}} .= $buffer;
+            if ( $str->{handler} ) {
+               my $tail = '';
+               $tail = $1 if $buffer =~ s/([^\n]+)\z//s;
+               foreach my $line ( split /^/m, $str->{buffer_tail}.$buffer ) {
+                  &{$str->{handler}}($line, $str->{name});
+               }
+               $str->{buffer_tail} = $tail;
+            }
+         } else {
+            $select->remove($fd);
+            $fd->close;
+         }
+      }
+   }
+
+   $self->{'out'} = $odata ? [ split /^/m,$odata ] : '';
+   $self->{'err'} = $edata ? [ split /^/m,$edata ] : '';
+   $out->close;
+   $err->close;
+   waitpid $pid,0;
+   $self->{'realstatus'} = $?;
+   $self->{'status'} = $?>>8;
+   return($self->{'status'} ? 0 : 1);
+}
+
+=over 4
+
+=item File::Rsync::list
+
+$out = $obj->list(@options);
+
+   or
+
+$out = $obj->list(\%options);
+
+   or
+
+@out = $obj->list(\%options);
+
+This is a wrapper for I<exec> called without a destination to get a listing.
+It returns the output of stdout like the I<out> function below.  When
+no destination is given rsync returns the equivalent of 'ls -l' or 'ls -lr'
+modified by any include/exclude/filter parameters you specify.  This is useful
+for manual comparison without actual changes to the destination or for
+comparing against another listing taken at a different point in time.
+
+(As of rsync version 2.6.4-pre1 this can also be accomplished with the
+'list-only' option regardless of whether a destination is given.)
+
+=back
+
+=cut
+
+sub list {
+   my $self = shift;
+   $self->{list}++;
+   $self->exec(@_);
+   if ($self->{'out'}) {
+      return(wantarray ? @{$self->{'out'}} : $self->{'out'});
+   } else {
+      return;
+   }
+}
+
+=over 4
+
+=item File::Rsync::status
+
+$rval = $obj->I<status>;
+
+Returns the status from last I<exec> call right shifted 8 bits.
+
+=back
+
+=cut
+
+sub status {
+   my $self = shift;
+   return $self->{'status'};
+}
+
+=over 4
+
+=item File::Rsync::realstatus
+
+$rval = $obj->I<realstatus>;
+
+Returns the real status from last I<exec> call (not right shifted).
+
+=back
+
+=cut
+
+sub realstatus {
+   my $self = shift;
+   return $self->{'realstatus'};
+}
+
+=over 4
+
+=item File::Rsync::err
+
+$aref = $obj->I<err>;
+
+In a scalar context this method will return a reference to an array containing
+all output to stderr from the last I<exec> call, or zero (false) if there
+was no output.  In an array context it will return an array of all output to
+stderr or an empty list.  The scalar context can be used to efficiently test
+for the existance of output.  I<rsync> sends all messages from the remote
+I<rsync> process and any error messages to stderr.  This method's purpose is
+to make it easier for you to parse that output for appropriate information.
+
+=back
+
+=cut
+
+sub err {
+   my $self = shift;
+   if ($self->{'err'}) {
+      return(wantarray ? @{$self->{'err'}} : $self->{'err'});
+   } else {
+      return;
+   }
+}
+
+=over 4
+
+=item File::Rsync::out
+
+$aref = $obj->I<out>;
+
+Similar to the I<err> method, in a scalar context it returns a reference to an
+array containing all output to stdout from the last I<exec> call, or zero
+(false) if there was no output.  In an array context it returns an array of all
+output to stdout or an empty list.  I<rsync> sends all informational messages
+(B<verbose> option) from the local I<rsync> process to stdout.
+
+=back
+
+=cut
+
+sub out {
+   my $self = shift;
+   if ($self->{'out'}) {
+      return(wantarray ? @{$self->{'out'}} : $self->{'out'});
+   } else {
+      return;
+   }
+}
+
+=over 4
+
+=item File::Rsync::lastcmd
+
+$aref = $obj->I<lastcmd>;
+
+Returns the actual system command used by the last I<exec> call, or '' before
+any calls to I<exec> for the object.  This can be useful in the case of an
+error condition to give a more informative message or for debugging purposes.
+In an array context it return an array of args as passed to the system, in
+a scalar context it returns a space-seperated string.  See I<getcmd> for access
+to the command before execution.
+
+=back
+
+=cut
+
+sub lastcmd {
+   my $self = shift;
+   if ($self->{lastcmd}) {
+      return wantarray ? @{$self->{lastcmd}} : join ' ',@{$self->{lastcmd}};
+   } else {
+      return;
+   }
+}
+
+=head1 Author
+
+Lee Eakin E<lt>[email protected]<gt>
+
+=head1 Credits
+
+The following people have contributed ideas, bug fixes, code or helped out
+by reporting or tracking down bugs in order to improve this module since
+it's initial release.  See the Changelog for details:
+
+Greg Ward
+
+Boris Goldowsky
+
+James Mello
+
+Andreas Koenig
+
+Joe Smith
+
+Jonathan Pelletier
+
+Heiko Jansen
+
+Tong Zhu
+
+Paul Egan
+
+Ronald J Kimball
+
+James CE Johnson
+
+Bill Uhl
+
+Peter teStrake
+
+Harald Flaucher
+
+Simon Myers
+
+Gavin Carr
+
+Petya Kohts
+
+=head1 Inspiration and Assistance
+
+Gerard Hickey                             C<PGP::Pipe>
+
+Russ Allbery                              C<PGP::Sign>
+
+Graham Barr                               C<Net::*>
+
+Andrew Tridgell and Paul Mackerras        rsync(1)
+
+John Steele   E<lt>[email protected]<gt>
+
+Philip Kizer  E<lt>[email protected]<gt>
+
+Larry Wall                                perl(1)
+
+I borrowed many clues on wrapping an external program from the PGP modules,
+and I would not have had such a useful tool to wrap except for the great work
+of the B<rsync> authors.  Thanks also to Graham Barr, the author of the libnet
+modules and many others, for looking over this code.  Of course I must mention
+the other half of my brain, John Steele, and his good friend Philip Kizer for
+finding B<rsync> and bringing it to my attention.  And I would not have been
+able to enjoy writing useful tools if not for the creator of the B<perl>
+language.
+
+=head1 Copyrights
+
+      Copyright (c) 1999-2005 Lee Eakin.  All rights reserved.
+ 
+      This program is free software; you can redistribute it and/or modify
+      it under the same terms as Perl itself. 
+
+=cut
+
+1;

+ 285 - 0
Frontier/Client.pm

@@ -0,0 +1,285 @@
+#
+# Copyright (C) 1998 Ken MacLeod
+# Frontier::Client is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Client.pm,v 1.8 2001/10/03 01:30:54 kmacleod Exp $
+#
+
+# NOTE: see Net::pRPC for a Perl RPC implementation
+
+use strict;
+
+package Frontier::Client;
+use Frontier::RPC2;
+use LWP::UserAgent;
+use HTTP::Request;
+
+use vars qw{$AUTOLOAD};
+
+sub new {
+    my $class = shift;
+    my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
+
+    bless $self, $class;
+
+    die "Frontier::RPC::new: no url defined\n"
+	if !defined $self->{'url'};
+
+    $self->{'ua'} = LWP::UserAgent->new;
+    $self->{'ua'}->proxy('http', $self->{'proxy'})
+	if(defined $self->{'proxy'});
+    $self->{'rq'} = HTTP::Request->new (POST => $self->{'url'});
+    $self->{'rq'}->header('Content-Type' => 'text/xml');
+
+    my @options;
+
+    if(defined $self->{'encoding'}) {
+	push @options, 'encoding' => $self->{'encoding'};
+    }
+
+    if (defined $self->{'use_objects'} && $self->{'use_objects'}) {
+	push @options, 'use_objects' => $self->{'use_objects'};
+    }
+
+    $self->{'enc'} = Frontier::RPC2->new(@options);
+
+    return $self;
+}
+
+sub call {
+    my $self = shift;
+
+    my $text = $self->{'enc'}->encode_call(@_);
+
+    if ($self->{'debug'}) {
+	print "---- request ----\n";
+	print $text;
+    }
+
+    $self->{'rq'}->content($text);
+
+    my $response = $self->{'ua'}->request($self->{'rq'});
+
+    if (!$response->is_success) {
+	die $response->status_line . "\n";
+    }
+
+    my $content = $response->content;
+
+    if ($self->{'debug'}) {
+	print "---- response ----\n";
+	print $content;
+    }
+
+    my $result = $self->{'enc'}->decode($content);
+
+    if ($result->{'type'} eq 'fault') {
+	die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
+	    . $result->{'value'}[0]{'faultString'} . "\n";
+    }
+
+    return $result->{'value'}[0];
+}
+
+# shortcuts
+sub base64 {
+    my $self = shift;
+
+    return Frontier::RPC2::Base64->new(@_);
+}
+
+sub boolean {
+    my $self = shift;
+
+    return Frontier::RPC2::Boolean->new(@_);
+}
+
+sub double {
+    my $self = shift;
+
+    return Frontier::RPC2::Double->new(@_);
+}
+
+sub int {
+    my $self = shift;
+
+    return Frontier::RPC2::Integer->new(@_);
+}
+
+sub string {
+    my $self = shift;
+
+    return Frontier::RPC2::String->new(@_);
+}
+
+sub date_time {
+    my $self = shift;
+
+    return Frontier::RPC2::DateTime::ISO8601->new(@_);
+}
+
+# something like this could be used to get an effect of
+#
+#     $server->examples_getStateName(41)
+#
+# instead of
+#
+#     $server->call('examples.getStateName', 41)
+#
+# for Frontier's
+#
+#     [server].examples.getStateName 41
+#
+# sub AUTOLOAD {
+#     my ($pkg, $method) = ($AUTOLOAD =~ m/^(.*::)(.*)$/);
+#     return if $method eq 'DESTROY';
+# 
+#     $method =~ s/__/=/g;
+#     $method =~ tr/_=/._/;
+# 
+#     splice(@_, 1, 0, $method);
+# 
+#     goto &call;
+# }
+
+=head1 NAME
+
+Frontier::Client - issue Frontier XML RPC requests to a server
+
+=head1 SYNOPSIS
+
+ use Frontier::Client;
+
+ $server = Frontier::Client->new( I<OPTIONS> );
+
+ $result = $server->call($method, @args);
+
+ $boolean = $server->boolean($value);
+ $date_time = $server->date_time($value);
+ $base64 = $server->base64($value);
+
+ $value = $boolean->value;
+ $value = $date_time->value;
+ $value = $base64->value;
+
+=head1 DESCRIPTION
+
+I<Frontier::Client> is an XML-RPC client over HTTP.
+I<Frontier::Client> instances are used to make calls to XML-RPC
+servers and as shortcuts for creating XML-RPC special data types.
+
+=head1 METHODS
+
+=over 4
+
+=item new( I<OPTIONS> )
+
+Returns a new instance of I<Frontier::Client> and associates it with
+an XML-RPC server at a URL.  I<OPTIONS> may be a list of key, value
+pairs or a hash containing the following parameters:
+
+=over 4
+
+=item url
+
+The URL of the server.  This parameter is required.  For example:
+
+ $server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2' );
+
+=item proxy
+
+A URL of a proxy to forward XML-RPC calls through.
+
+=item encoding
+
+The XML encoding to be specified in the XML declaration of outgoing
+RPC requests.  Incoming results may have a different encoding
+specified; XML::Parser will convert incoming data to UTF-8.  The
+default outgoing encoding is none, which uses XML 1.0's default of
+UTF-8.  For example:
+
+ $server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2',
+                                  'encoding' => 'ISO-8859-1' );
+
+=item use_objects
+
+If set to a non-zero value will convert incoming E<lt>i4E<gt>,
+E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
+scalars.  See int(), float(), and string() below for more details.
+
+=item debug
+
+If set to a non-zero value will print the encoded XML request and the
+XML response received.
+
+=back
+
+=item call($method, @args)
+
+Forward a procedure call to the server, either returning the value
+returned by the procedure or failing with exception.  `C<$method>' is
+the name of the server method, and `C<@args>' is a list of arguments
+to pass.  Arguments may be Perl hashes, arrays, scalar values, or the
+XML-RPC special data types below.
+
+=item boolean( $value )
+
+=item date_time( $value )
+
+=item base64( $base64 )
+
+The methods `C<boolean()>', `C<date_time()>', and `C<base64()>' create
+and return XML-RPC-specific datatypes that can be passed to
+`C<call()>'.  Results from servers may also contain these datatypes.
+The corresponding package names (for use with `C<ref()>', for example)
+are `C<Frontier::RPC2::Boolean>',
+`C<Frontier::RPC2::DateTime::ISO8601>', and
+`C<Frontier::RPC2::Base64>'.
+
+The value of boolean, date/time, and base64 data can be set or
+returned using the `C<value()>' method.  For example:
+
+  # To set a value:
+  $a_boolean->value(1);
+
+  # To retrieve a value
+  $base64 = $base64_xml_rpc_data->value();
+
+Note: `C<base64()>' does I<not> encode or decode base64 data for you,
+you must use MIME::Base64 or similar module for that.
+
+=item int( 42 );
+
+=item float( 3.14159 );
+
+=item string( "Foo" );
+
+By default, you may pass ordinary Perl values (scalars) to be encoded.
+RPC2 automatically converts them to XML-RPC types if they look like an
+integer, float, or as a string.  This assumption causes problems when
+you want to pass a string that looks like "0096", RPC2 will convert
+that to an E<lt>i4E<gt> because it looks like an integer.  With these
+methods, you could now create a string object like this:
+
+  $part_num = $server->string("0096");
+
+and be confident that it will be passed as an XML-RPC string.  You can
+change and retrieve values from objects using value() as described
+above.
+
+=back
+
+=head1 SEE ALSO
+
+perl(1), Frontier::RPC2(3)
+
+<http://www.scripting.com/frontier5/xml/code/rpc.html>
+
+=head1 AUTHOR
+
+Ken MacLeod <[email protected]>
+
+=cut
+
+1;

+ 96 - 0
Frontier/Daemon.pm

@@ -0,0 +1,96 @@
+#
+# Copyright (C) 1998 Ken MacLeod
+# Frontier::Daemon is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: Daemon.pm,v 1.5 2001/10/03 01:30:54 kmacleod Exp $
+#
+
+# NOTE: see Net::pRPC for a Perl RPC implementation
+
+###
+### NOTE: $self is inherited from HTTP::Daemon and the weird access
+### comes from there (`${*$self}').
+###
+
+use strict;
+
+package Frontier::Daemon;
+use vars qw{@ISA};
+
+@ISA = qw{HTTP::Daemon};
+
+use Frontier::RPC2;
+use HTTP::Daemon;
+use HTTP::Status;
+
+sub new {
+    my $class = shift; my %args = @_;
+    my $self = $class->SUPER::new(%args);
+    return undef unless $self;
+
+    ${*$self}{'methods'} = $args{'methods'};
+    ${*$self}{'decode'} = new Frontier::RPC2 'use_objects' => $args{'use_objects'};
+    ${*$self}{'response'} = new HTTP::Response 200;
+    ${*$self}{'response'}->header('Content-Type' => 'text/xml');
+
+    my $conn;
+    while ($conn = $self->accept) {
+	my $rq = $conn->get_request;
+	if ($rq) {
+	    if ($rq->method eq 'POST' && $rq->url->path eq '/RPC2') {
+                ${*$self}{'response'}->content(${*$self}{'decode'}->serve($rq->content, ${*$self}{'methods'}));
+                $conn->send_response(${*$self}{'response'});
+	    } else {
+		$conn->send_error(RC_FORBIDDEN);
+	    }
+	}
+        $conn->close;
+	$conn = undef;		# close connection
+    }
+
+    return $self;
+}
+
+=head1 NAME
+
+Frontier::Daemon - receive Frontier XML RPC requests
+
+=head1 SYNOPSIS
+
+ use Frontier::Daemon;
+
+ Frontier::Daemon->new(methods => {
+     'rpcName' => \&sub_name,
+        ...
+     });
+
+=head1 DESCRIPTION
+
+I<Frontier::Daemon> is an HTTP/1.1 server that listens on a socket for
+incoming requests containing Frontier XML RPC2 method calls.
+I<Frontier::Daemon> is a subclass of I<HTTP::Daemon>, which is a
+subclass of I<IO::Socket::INET>.
+
+I<Frontier::Daemon> takes a `C<methods>' parameter, a hash that maps
+an incoming RPC method name to reference to a subroutine.
+
+I<Frontier::Daemon> takes a `C<use_objects>' parameter that if set to
+a non-zero value will convert incoming E<lt>intE<gt>, E<lt>i4E<gt>,
+E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
+scalars.  See int(), float(), and string() in Frontier::RPC2 for more
+details.
+
+=head1 SEE ALSO
+
+perl(1), HTTP::Daemon(3), IO::Socket::INET(3), Frontier::RPC2(3)
+
+<http://www.scripting.com/frontier5/xml/code/rpc.html>
+
+=head1 AUTHOR
+
+Ken MacLeod <[email protected]>
+
+=cut
+
+1;

+ 95 - 0
Frontier/Daemon/Forking.pm

@@ -0,0 +1,95 @@
+package Frontier::Daemon::Forking;
+# $Id: Forking.pm,v 1.6 2004/01/23 19:48:33 tcaine Exp $
+
+use strict;
+use vars qw{@ISA $VERSION};
+
+$VERSION = '0.02';
+
+use Frontier::RPC2;
+use HTTP::Daemon;
+use HTTP::Status;
+
+@ISA = qw{HTTP::Daemon};
+
+#  most of this routine comes directly from Frontier::Daemon
+sub new {
+    my $class    = shift; 
+    my %args     = @_;
+    my $encoding = delete $args{encoding};
+    my $self     = $class->SUPER::new( %args );
+    return undef unless $self;
+
+    my @options;
+    push @options, encoding => $encoding
+        if $encoding;
+
+    ${*$self}{methods}  = $args{methods};
+    ${*$self}{decode}   = new Frontier::RPC2(@options);
+    ${*$self}{response} = new HTTP::Response 200;
+    ${*$self}{response}->header( 'Content-Type' => 'text/xml' );
+
+    local $SIG{CHLD} = 'IGNORE';
+
+ACCEPT:
+    while ( my $conn = $self->accept ) {
+        my $pid = fork;
+        next ACCEPT if $pid;
+
+        if ( not defined $pid ) {
+            warn "fork() failed: $!";
+            $conn = undef;
+        } 
+        else {
+            my $request = $conn->get_request;
+            if ($request) {
+                if ($request->method eq 'POST' && $request->url->path eq '/RPC2') {
+                    ${*$self}{'response'}->content(
+                        ${*$self}{'decode'}->serve(
+                            $request->content, 
+                            ${*$self}{'methods'},
+                        )
+                    );
+                    $conn->send_response(${*$self}{'response'});
+                } else {
+                    $conn->send_error(RC_FORBIDDEN);
+                }
+            }
+        }
+        exit;
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Frontier::Daemon::Forking - receive Frontier XML RPC requests
+
+=head1 SYNOPSIS
+
+  use Frontier::Daemon::Forking;
+
+  Frontier::Daemon::Forking->new(
+      methods => {
+          rpcName => \&rpcHandler,
+      },
+      encoding => 'ISO-8859-1',
+  );
+
+  sub rpcHandler { return 'OK' }
+
+=head1 DESCRIPTION
+
+L<Frontier::Daemon::Forking> is a drop in replacement for L<Frontier::Daemon> when a forking HTTP/1.1 server is needed that listens on a socket for incoming requests containing Frontier XML RPC2 method calls.  Most of the code was borrowed from L<Frontier::Daemon>.
+
+=head1 AUTHOR
+
+Todd Caine, [email protected]
+
+=head1 SEE ALSO
+
+L<Frontier::RPC2>, L<Frontier::Daemon>, L<HTTP::Daemon>
+
+=cut

+ 701 - 0
Frontier/RPC2.pm

@@ -0,0 +1,701 @@
+#
+# Copyright (C) 1998, 1999 Ken MacLeod
+# Frontier::RPC is free software; you can redistribute it
+# and/or modify it under the same terms as Perl itself.
+#
+# $Id: RPC2.pm,v 1.18 2002/08/02 18:35:21 ivan420 Exp $
+#
+
+# NOTE: see Storable for marshalling.
+
+use strict;
+
+package Frontier::RPC2;
+use XML::Parser;
+
+use vars qw{%scalars %char_entities};
+
+%char_entities = (
+    '&' => '&amp;',
+    '<' => '&lt;',
+    '>' => '&gt;',
+    '"' => '&quot;',
+);
+
+# FIXME I need a list of these
+%scalars = (
+    'base64' => 1,
+    'boolean' => 1,
+    'dateTime.iso8601' => 1,
+    'double' => 1,
+    'int' => 1,
+    'i4' => 1,
+    'string' => 1,
+);
+
+sub new {
+    my $class = shift;
+    my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
+
+    bless $self, $class;
+
+    if (defined $self->{'encoding'}) {
+	$self->{'encoding_'} = " encoding=\"$self->{'encoding'}\"";
+    } else {
+	$self->{'encoding_'} = "";
+    }
+
+    return $self;
+}
+
+sub encode_call {
+    my $self = shift; my $proc = shift;
+
+    my @text;
+    push @text, <<EOF;
+<?xml version="1.0"$self->{'encoding_'}?>
+<methodCall>
+<methodName>$proc</methodName>
+<params>
+EOF
+
+    push @text, $self->_params([@_]);
+
+    push @text, <<EOF;
+</params>
+</methodCall>
+EOF
+
+    return join('', @text);
+}
+
+sub encode_response {
+    my $self = shift;
+
+    my @text;
+    push @text, <<EOF;
+<?xml version="1.0"$self->{'encoding_'}?>
+<methodResponse>
+<params>
+EOF
+
+    push @text, $self->_params([@_]);
+
+    push @text, <<EOF;
+</params>
+</methodResponse>
+EOF
+
+    return join('', @text);
+}
+
+sub encode_fault {
+    my $self = shift; my $code = shift; my $message = shift;
+
+    my @text;
+    push @text, <<EOF;
+<?xml version="1.0"$self->{'encoding_'}?>
+<methodResponse>
+<fault>
+EOF
+
+    push @text, $self->_item({faultCode => $code, faultString => $message});
+
+    push @text, <<EOF;
+</fault>
+</methodResponse>
+EOF
+
+    return join('', @text);
+}
+
+sub serve {
+    my $self = shift; my $xml = shift; my $methods = shift;
+
+    my $call;
+    # FIXME bug in Frontier's XML
+    $xml =~ s/(<\?XML\s+VERSION)/\L$1\E/;
+    eval { $call = $self->decode($xml) };
+
+    if ($@) {
+	return $self->encode_fault(1, "error decoding RPC.\n" . $@);
+    }
+
+    if ($call->{'type'} ne 'call') {
+	return $self->encode_fault(2,"expected RPC \`methodCall', got \`$call->{'type'}'\n");
+    }
+
+    my $method = $call->{'method_name'};
+    if (!defined $methods->{$method}) {
+        return $self->encode_fault(3, "no such method \`$method'\n");
+    }
+
+    my $result;
+    my $eval = eval { $result = &{ $methods->{$method} }(@{ $call->{'value'} }) };
+    if ($@) {
+	return $self->encode_fault(4, "error executing RPC \`$method'.\n" . $@);
+    }
+
+    my $response_xml = $self->encode_response($result);
+    return $response_xml;
+}
+
+sub _params {
+    my $self = shift; my $array = shift;
+
+    my @text;
+
+    my $item;
+    foreach $item (@$array) {
+	push (@text, "<param>",
+	      $self->_item($item),
+	      "</param>\n");
+    }
+
+    return @text;
+}
+
+sub _item {
+    my $self = shift; my $item = shift;
+
+    my @text;
+
+    my $ref = ref($item);
+    if (!$ref) {
+	push (@text, $self->_scalar ($item));
+    } elsif ($ref eq 'ARRAY') {
+	push (@text, $self->_array($item));
+    } elsif ($ref eq 'HASH') {
+	push (@text, $self->_hash($item));
+    } elsif ($ref eq 'Frontier::RPC2::Boolean') {
+	push @text, "<value><boolean>", $item->repr, "</boolean></value>\n";
+    } elsif ($ref eq 'Frontier::RPC2::String') {
+      push @text, "<value><string>", $item->repr, "</string></value>\n";
+    } elsif ($ref eq 'Frontier::RPC2::Integer') {
+      push @text, "<value><int>", $item->repr, "</int></value>\n";
+    } elsif ($ref eq 'Frontier::RPC2::Double') {
+      push @text, "<value><double>", $item->repr, "</double></value>\n";
+    } elsif ($ref eq 'Frontier::RPC2::DateTime::ISO8601') {
+	push @text, "<value><dateTime.iso8601>", $item->repr, "</dateTime.iso8601></value>\n";
+    } elsif ($ref eq 'Frontier::RPC2::Base64') {
+	push @text, "<value><base64>", $item->repr, "</base64></value>\n";
+    } elsif ($ref =~ /=HASH\(/) {
+	push @text, $self->_hash($item);
+    } elsif ($ref =~ /=ARRAY\(/) {
+	push @text, $self->_array($item);
+    } else {
+	die "can't convert \`$item' to XML\n";
+    }
+
+    return @text;
+}
+
+sub _hash {
+    my $self = shift; my $hash = shift;
+
+    my @text = "<value><struct>\n";
+
+    my ($key, $value);
+    while (($key, $value) = each %$hash) {
+	push (@text,
+	      "<member><name>$key</name>",
+	      $self->_item($value),
+	      "</member>\n");
+    }
+
+    push @text, "</struct></value>\n";
+
+    return @text;
+}
+
+
+sub _array {
+    my $self = shift; my $array = shift;
+
+    my @text = "<value><array><data>\n";
+
+    my $item;
+    foreach $item (@$array) {
+	push @text, $self->_item($item);
+    }
+
+    push @text, "</data></array></value>\n";
+
+    return @text;
+}
+
+sub _scalar {
+    my $self = shift; my $value = shift;
+
+    # these are from `perldata(1)'
+    if ($value =~ /^[+-]?\d+$/) {
+	return ("<value><i4>$value</i4></value>");
+    } elsif ($value =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/) {
+	return ("<value><double>$value</double></value>");
+    } else {
+	$value =~ s/([&<>\"])/$char_entities{$1}/ge;
+	return ("<value><string>$value</string></value>");
+    }
+}
+
+sub decode {
+    my $self = shift; my $string = shift;
+
+    $self->{'parser'} = XML::Parser->new( Style => ref($self),
+					  'use_objects' => $self->{'use_objects'} );
+    return $self->{'parser'}->parsestring($string);
+}
+
+# shortcuts
+sub base64 {
+    my $self = shift;
+
+    return Frontier::RPC2::Base64->new(@_);
+}
+
+sub boolean {
+    my $self = shift;
+    my $elem = shift;
+    if($elem == 0 or $elem == 1) {
+        return Frontier::RPC2::Boolean->new($elem);
+    } else {
+        die "error in rendering RPC type \`$elem\' not a boolean\n";
+    }
+}
+
+sub double {
+    my $self = shift;
+    my $elem = shift;
+    # this is from `perldata(1)'
+    if($elem =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
+        return Frontier::RPC2::Double->new($elem);
+    } else {
+        die "error in rendering RPC type \`$elem\' not a double\n";
+    } 
+}
+
+sub int {
+    my $self = shift;
+    my $elem = shift; 
+    # this is from `perldata(1)'
+    if($elem =~ /^[+-]?\d+$/) {
+        return Frontier::RPC2::Integer->new($elem);
+    } else {
+        die "error in rendering RPC type \`$elem\' not an int\n";
+    }
+}
+
+sub string {
+    my $self = shift;
+
+    return Frontier::RPC2::String->new(@_);
+}
+
+sub date_time {
+    my $self = shift;
+
+    return Frontier::RPC2::DateTime::ISO8601->new(@_);
+}
+
+######################################################################
+###
+### XML::Parser callbacks
+###
+
+sub die {
+    my $expat = shift; my $message = shift;
+
+    die $message
+	. "at line " . $expat->current_line
+        . " column " . $expat->current_column . "\n";
+}
+
+sub init {
+    my $expat = shift;
+
+    $expat->{'rpc_state'} = [];
+    $expat->{'rpc_container'} = [ [] ];
+    $expat->{'rpc_member_name'} = [];
+    $expat->{'rpc_type'} = undef;
+    $expat->{'rpc_args'} = undef;
+}
+
+# FIXME this state machine wouldn't be necessary if we had a DTD.
+sub start {
+    my $expat = shift; my $tag = shift;
+
+    my $state = $expat->{'rpc_state'}[-1];
+
+    if (!defined $state) {
+	if ($tag eq 'methodCall') {
+	    $expat->{'rpc_type'} = 'call';
+	    push @{ $expat->{'rpc_state'} }, 'want_method_name';
+	} elsif ($tag eq 'methodResponse') {
+	    push @{ $expat->{'rpc_state'} }, 'method_response';
+	} else {
+	    Frontier::RPC2::die($expat, "unknown RPC type \`$tag'\n");
+	}
+    } elsif ($state eq 'want_method_name') {
+	Frontier::RPC2::die($expat, "wanted \`methodName' tag, got \`$tag'\n")
+	    if ($tag ne 'methodName');
+	push @{ $expat->{'rpc_state'} }, 'method_name';
+	$expat->{'rpc_text'} = "";
+    } elsif ($state eq 'method_response') {
+	if ($tag eq 'params') {
+	    $expat->{'rpc_type'} = 'response';
+	    push @{ $expat->{'rpc_state'} }, 'params';
+	} elsif ($tag eq 'fault') {
+	    $expat->{'rpc_type'} = 'fault';
+	    push @{ $expat->{'rpc_state'} }, 'want_value';
+	}
+    } elsif ($state eq 'want_params') {
+	Frontier::RPC2::die($expat, "wanted \`params' tag, got \`$tag'\n")
+	    if ($tag ne 'params');
+	push @{ $expat->{'rpc_state'} }, 'params';
+    } elsif ($state eq 'params') {
+	Frontier::RPC2::die($expat, "wanted \`param' tag, got \`$tag'\n")
+	    if ($tag ne 'param');
+	push @{ $expat->{'rpc_state'} }, 'want_param_name_or_value';
+    } elsif ($state eq 'want_param_name_or_value') {
+	if ($tag eq 'value') {
+	    $expat->{'may_get_cdata'} = 1;
+	    $expat->{'rpc_text'} = "";
+	    push @{ $expat->{'rpc_state'} }, 'value';
+	} elsif ($tag eq 'name') {
+	    push @{ $expat->{'rpc_state'} }, 'param_name';
+	} else {	    
+	    Frontier::RPC2::die($expat, "wanted \`value' or \`name' tag, got \`$tag'\n");
+	}
+    } elsif ($state eq 'param_name') {
+	Frontier::RPC2::die($expat, "wanted parameter name data, got tag \`$tag'\n");
+    } elsif ($state eq 'want_value') {
+	Frontier::RPC2::die($expat, "wanted \`value' tag, got \`$tag'\n")
+	    if ($tag ne 'value');
+	$expat->{'rpc_text'} = "";
+	$expat->{'may_get_cdata'} = 1;
+	push @{ $expat->{'rpc_state'} }, 'value';
+    } elsif ($state eq 'value') {
+	$expat->{'may_get_cdata'} = 0;
+	if ($tag eq 'array') {
+	    push @{ $expat->{'rpc_container'} }, [];
+	    push @{ $expat->{'rpc_state'} }, 'want_data';
+	} elsif ($tag eq 'struct') {
+	    push @{ $expat->{'rpc_container'} }, {};
+	    push @{ $expat->{'rpc_member_name'} }, undef;
+	    push @{ $expat->{'rpc_state'} }, 'struct';
+	} elsif ($scalars{$tag}) {
+	    $expat->{'rpc_text'} = "";
+	    push @{ $expat->{'rpc_state'} }, 'cdata';
+	} else {
+	    Frontier::RPC2::die($expat, "wanted a data type, got \`$tag'\n");
+	}
+    } elsif ($state eq 'want_data') {
+	Frontier::RPC2::die($expat, "wanted \`data', got \`$tag'\n")
+	    if ($tag ne 'data');
+	push @{ $expat->{'rpc_state'} }, 'array';
+    } elsif ($state eq 'array') {
+	Frontier::RPC2::die($expat, "wanted \`value' tag, got \`$tag'\n")
+	    if ($tag ne 'value');
+	$expat->{'rpc_text'} = "";
+	$expat->{'may_get_cdata'} = 1;
+	push @{ $expat->{'rpc_state'} }, 'value';
+    } elsif ($state eq 'struct') {
+	Frontier::RPC2::die($expat, "wanted \`member' tag, got \`$tag'\n")
+	    if ($tag ne 'member');
+	push @{ $expat->{'rpc_state'} }, 'want_member_name';
+    } elsif ($state eq 'want_member_name') {
+	Frontier::RPC2::die($expat, "wanted \`name' tag, got \`$tag'\n")
+	    if ($tag ne 'name');
+	push @{ $expat->{'rpc_state'} }, 'member_name';
+	$expat->{'rpc_text'} = "";
+    } elsif ($state eq 'member_name') {
+	Frontier::RPC2::die($expat, "wanted data, got tag \`$tag'\n");
+    } elsif ($state eq 'cdata') {
+	Frontier::RPC2::die($expat, "wanted data, got tag \`$tag'\n");
+    } else {
+	Frontier::RPC2::die($expat, "internal error, unknown state \`$state'\n");
+    }
+}
+
+sub end {
+    my $expat = shift; my $tag = shift;
+
+    my $state = pop @{ $expat->{'rpc_state'} };
+
+    if ($state eq 'cdata') {
+	my $value = $expat->{'rpc_text'};
+	if ($tag eq 'base64') {
+	    $value = Frontier::RPC2::Base64->new($value);
+	} elsif ($tag eq 'boolean') {
+	    $value = Frontier::RPC2::Boolean->new($value);
+	} elsif ($tag eq 'dateTime.iso8601') {
+	    $value = Frontier::RPC2::DateTime::ISO8601->new($value);
+	} elsif ($expat->{'use_objects'}) {
+	    if ($tag eq 'i4' or $tag eq 'int') {
+		$value = Frontier::RPC2::Integer->new($value);
+	    } elsif ($tag eq 'float') {
+		$value = Frontier::RPC2::Float->new($value);
+	    } elsif ($tag eq 'string') {
+		$value = Frontier::RPC2::String->new($value);
+	    }
+	}
+	$expat->{'rpc_value'} = $value;
+    } elsif ($state eq 'member_name') {
+	$expat->{'rpc_member_name'}[-1] = $expat->{'rpc_text'};
+	$expat->{'rpc_state'}[-1] = 'want_value';
+    } elsif ($state eq 'method_name') {
+	$expat->{'rpc_method_name'} = $expat->{'rpc_text'};
+	$expat->{'rpc_state'}[-1] = 'want_params';
+    } elsif ($state eq 'struct') {
+	$expat->{'rpc_value'} = pop @{ $expat->{'rpc_container'} };
+	pop @{ $expat->{'rpc_member_name'} };
+    } elsif ($state eq 'array') {
+	$expat->{'rpc_value'} = pop @{ $expat->{'rpc_container'} };
+    } elsif ($state eq 'value') {
+	# the rpc_text is a string if no type tags were given
+	if ($expat->{'may_get_cdata'}) {
+	    $expat->{'may_get_cdata'} = 0;
+	    if ($expat->{'use_objects'}) {
+		$expat->{'rpc_value'}
+		= Frontier::RPC2::String->new($expat->{'rpc_text'});
+	    } else {
+		$expat->{'rpc_value'} = $expat->{'rpc_text'};
+	    }
+	}
+	my $container = $expat->{'rpc_container'}[-1];
+	if (ref($container) eq 'ARRAY') {
+	    push @$container, $expat->{'rpc_value'};
+	} elsif (ref($container) eq 'HASH') {
+	    $container->{ $expat->{'rpc_member_name'}[-1] } = $expat->{'rpc_value'};
+	}
+    }
+}
+
+sub char {
+    my $expat = shift; my $text = shift;
+
+    $expat->{'rpc_text'} .= $text;
+}
+
+sub proc {
+}
+
+sub final {
+    my $expat = shift;
+
+    $expat->{'rpc_value'} = pop @{ $expat->{'rpc_container'} };
+    
+    return {
+	value => $expat->{'rpc_value'},
+	type => $expat->{'rpc_type'},
+	method_name => $expat->{'rpc_method_name'},
+    };
+}
+
+package Frontier::RPC2::DataType;
+
+sub new {
+    my $type = shift; my $value = shift;
+
+    return bless \$value, $type;
+}
+
+# `repr' returns the XML representation of this data, which may be
+# different [in the future] from what is returned from `value'
+sub repr {
+    my $self = shift;
+
+    return $$self;
+}
+
+# sets or returns the usable value of this data
+sub value {
+    my $self = shift;
+    @_ ? ($$self = shift) : $$self;
+}
+
+package Frontier::RPC2::Base64;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+package Frontier::RPC2::Boolean;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+package Frontier::RPC2::Integer;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+package Frontier::RPC2::String;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+sub repr {
+    my $self = shift;
+    my $value = $$self;
+    $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge;
+    $value;
+}
+
+package Frontier::RPC2::Double;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+package Frontier::RPC2::DateTime::ISO8601;
+
+use vars qw{@ISA};
+@ISA = qw{Frontier::RPC2::DataType};
+
+=head1 NAME
+
+Frontier::RPC2 - encode/decode RPC2 format XML
+
+=head1 SYNOPSIS
+
+ use Frontier::RPC2;
+
+ $coder = Frontier::RPC2->new;
+
+ $xml_string = $coder->encode_call($method, @args);
+ $xml_string = $coder->encode_response($result);
+ $xml_string = $coder->encode_fault($code, $message);
+
+ $call = $coder->decode($xml_string);
+
+ $response_xml = $coder->serve($request_xml, $methods);
+
+ $boolean_object = $coder->boolean($boolean);
+ $date_time_object = $coder->date_time($date_time);
+ $base64_object = $coder->base64($base64);
+ $int_object = $coder->int(42);
+ $float_object = $coder->float(3.14159);
+ $string_object = $coder->string("Foo");
+
+=head1 DESCRIPTION
+
+I<Frontier::RPC2> encodes and decodes XML RPC calls.
+
+=over 4
+
+=item $coder = Frontier::RPC2->new( I<OPTIONS> )
+
+Create a new encoder/decoder.  The following option is supported:
+
+=over 4
+
+=item encoding
+
+The XML encoding to be specified in the XML declaration of encoded RPC
+requests or responses.  Decoded results may have a different encoding
+specified; XML::Parser will convert decoded data to UTF-8.  The
+default encoding is none, which uses XML 1.0's default of UTF-8.  For
+example:
+
+ $server = Frontier::RPC2->new( 'encoding' => 'ISO-8859-1' );
+
+=item use_objects
+
+If set to a non-zero value will convert incoming E<lt>i4E<gt>,
+E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
+scalars.  See int(), float(), and string() below for more details.
+
+=back
+
+=item $xml_string = $coder->encode_call($method, @args)
+
+`C<encode_call>' converts a method name and it's arguments into an
+RPC2 `C<methodCall>' element, returning the XML fragment.
+
+=item $xml_string = $coder->encode_response($result)
+
+`C<encode_response>' converts the return value of a procedure into an
+RPC2 `C<methodResponse>' element containing the result, returning the
+XML fragment.
+
+=item $xml_string = $coder->encode_fault($code, $message)
+
+`C<encode_fault>' converts a fault code and message into an RPC2
+`C<methodResponse>' element containing a `C<fault>' element, returning
+the XML fragment.
+
+=item $call = $coder->decode($xml_string)
+
+`C<decode>' converts an XML string containing an RPC2 `C<methodCall>'
+or `C<methodResponse>' element into a hash containing three members,
+`C<type>', `C<value>', and `C<method_name>'.  `C<type>' is one of
+`C<call>', `C<response>', or `C<fault>'.  `C<value>' is array
+containing the parameters or result of the RPC.  For a `C<call>' type,
+`C<value>' contains call's parameters and `C<method_name>' contains
+the method being called.  For a `C<response>' type, the `C<value>'
+array contains call's result.  For a `C<fault>' type, the `C<value>'
+array contains a hash with the two members `C<faultCode>' and
+`C<faultMessage>'.
+
+=item $response_xml = $coder->serve($request_xml, $methods)
+
+`C<serve>' decodes `C<$request_xml>', looks up the called method name
+in the `C<$methods>' hash and calls it, and then encodes and returns
+the response as XML.
+
+=item $boolean_object = $coder->boolean($boolean);
+
+=item $date_time_object = $coder->date_time($date_time);
+
+=item $base64_object = $coder->base64($base64);
+
+These methods create and return XML-RPC-specific datatypes that can be
+passed to the encoder.  The decoder may also return these datatypes.
+The corresponding package names (for use with `C<ref()>', for example)
+are `C<Frontier::RPC2::Boolean>',
+`C<Frontier::RPC2::DateTime::ISO8601>', and
+`C<Frontier::RPC2::Base64>'.
+
+You can change and retrieve the value of boolean, date/time, and
+base64 data using the `C<value>' method of those objects, i.e.:
+
+  $boolean = $boolean_object->value;
+
+  $boolean_object->value(1);
+
+Note: `C<base64()>' does I<not> encode or decode base64 data for you,
+you must use MIME::Base64 or similar module for that.
+
+=item $int_object = $coder->int(42);
+
+=item $float_object = $coder->float(3.14159);
+
+=item $string_object = $coder->string("Foo");
+
+By default, you may pass ordinary Perl values (scalars) to be encoded.
+RPC2 automatically converts them to XML-RPC types if they look like an
+integer, float, or as a string.  This assumption causes problems when
+you want to pass a string that looks like "0096", RPC2 will convert
+that to an E<lt>i4E<gt> because it looks like an integer.  With these
+methods, you could now create a string object like this:
+
+  $part_num = $coder->string("0096");
+
+and be confident that it will be passed as an XML-RPC string.  You can
+change and retrieve values from objects using value() as described
+above.
+
+=back
+
+=head1 SEE ALSO
+
+perl(1), Frontier::Daemon(3), Frontier::Client(3)
+
+<http://www.scripting.com/frontier5/xml/code/rpc.html>
+
+=head1 AUTHOR
+
+Ken MacLeod <[email protected]>
+
+=cut
+
+1;

+ 170 - 0
Frontier/Responder.pm

@@ -0,0 +1,170 @@
+# File:      Repsonder.pm
+#            based heavily on Ken MacLeod's Frontier::Daemon
+# Author:    Joe Johnston 7/2000
+# Revisions: 
+#            11/2000 - Cleaned/Add POD. Took out 'use CGI'. 
+#  
+# Meant to be called from a CGI process to answer client 
+# requests and emit the appropriate reponses. See POD for details.
+#
+# LICENSE: This code is released under the same licensing 
+#          as Perl itself.
+#
+# Use the code where ever you want, but due credit is appreciated. 
+
+package Frontier::Responder;
+
+use strict;
+use vars qw/@ISA/;
+
+use Frontier::RPC2;
+
+my $snappy_answer = "Hey, I need to return true, don't I?";
+
+# Class constructor. 
+# Input:  (expects parameters to be passed in as a hash)
+#         methods => hashref, keys are API procedure names, values are
+#                    subroutine references
+#
+# Output: blessed reference
+sub new {
+    my $class = shift; 
+    my %args  = @_;
+    my $self  = bless {}, (ref $class ? ref $class : $class);
+
+    # Store the dispatch table away for future use.
+    $self->{methods}  = $args{methods};
+    $self->{_decode}  = Frontier::RPC2->new();
+
+    return $self;
+}
+
+# Grabs input from CGI "stream", makes request 
+# if possible, packs up the response in purddy
+# XML
+# Input:  None
+# Output: A XML string suitable for printing from a CGI process
+sub answer{
+    my $self = shift;
+
+    # fetch the xml message sent
+    my $request = get_cgi_request();
+    
+    unless( defined $request ){
+	print 
+	    "Content-Type: text/txt\n\n";
+	exit;
+    }
+
+    # Let's figure out the method to execute
+    # along with its arguments
+    my $response = $self->{_decode}->serve( $request, 
+					    $self->{methods} );
+    # Ship it!
+    return 
+	"Content-Type: text/xml \n\n" . $response;
+
+}
+
+# private function. No need to advertise this.
+# Remember, this is just XML. 
+# CGI.pm doesn't grok this.
+sub get_cgi_request{
+    my $in;
+    if( $ENV{REQUEST_METHOD} eq 'POST' ){
+        my $len = $ENV{CONTENT_LENGTH};
+	unless ( read( STDIN, $in, $len ) == $len ){
+	    return;
+        }
+    }else{
+	$in = $ENV{QUERY_STRING};
+    }
+    
+    return $in;
+}
+
+=pod
+
+=head1 NAME
+
+Frontier::Responder - Create XML-RPC listeners for normal CGI processes 
+
+=head1 SYNOPSIS
+
+ use Frontier::Responder; 
+ my $res = Frontier::Responder->new( methods => {
+                                                 add => sub{ $_[0] + $_[1] },
+						 cat => sub{ $_[0] . $_[1] },
+					        },
+				    );
+ print $res->answer;
+
+=head1 DESCRIPTION
+
+Use I<Frontier::Responder> whenever you need to create an XML-RPC listener
+using a standard CGI interface. To be effective, a script using this class
+will often have to be put a directory from which a web server is authorized 
+to execute CGI programs. An XML-RPC listener using this library will be 
+implementing the API of a particular XML-RPC application. Each remote 
+procedure listed in the API of the user defined application will correspond
+to a hash key that is defined in the C<new> method of a I<Frontier::Responder>
+object. This is exactly the way I<Frontier::Daemon> works as well. 
+In order to process the request and get the response, the C<answer> method
+is needed. Its return value is XML ready for printing. 
+
+For those new to XML-RPC, here is a brief description of this protocol. 
+XML-RPC is a way to execute functions on a different 
+machine. Both the client's request and listeners response are wrapped 
+up in XML and sent over HTTP. Because the XML-RPC conversation is in 
+XML, the implementation languages of the server (here called a I<listener>), 
+and the client can be different. This can be a powerful and simple way
+to have very different platforms work together without acrimony. Implicit 
+in the use of XML-RPC is a contract or API that an XML-RPC listener 
+implements and an XML-RPC client calls. The API needs to list not only 
+the various procedures that can be called, but also the XML-RPC datatypes
+expected for input and output. Remember that although Perl is permissive
+about datatyping, other languages are not. Unforuntately, the XML-RPC spec
+doesn't say how to document the API. It is recomended that the author
+of a Perl XML-RPC listener should at least use POD to explain the API.
+This allows for the programmatic generation of a clean web page.  
+
+=head1 METHODS
+
+=over 4
+
+=item new( I<OPTIONS> )
+
+This is the class constructor. As is traditional, it returns 
+a blessed reference to a I<Frontier::Responder> object. It expects 
+arguments to be given like a hash (Perl's named parameter mechanism). 
+To be effective, populate the C<methods> parameter with a hashref 
+that has API procedure names as keys and subroutine references as 
+values. See the SYNOPSIS for a sample usage.
+
+
+=item answer()
+
+In order to parse the request and execute the procedure, this method
+must be called. It returns a XML string that contains the procedure's 
+response. In a typical CGI program, this string will simply be printed
+to STDOUT. 
+
+
+=back
+
+=head1 SEE ALSO
+
+perl(1), Frontier::RPC2(3)
+
+<http://www.scripting.com/frontier5/xml/code/rpc.html>
+
+=head1 AUTHOR
+
+Ken MacLeod <[email protected]> wrote the underlying
+RPC library. 
+
+Joe Johnston <[email protected]> wrote an adaptation
+of the Frontier::Daemon class to create this CGI XML-RPC 
+listener class.
+
+=cut

+ 36 - 0
IspConfig/sites_ftp_user_add.php

@@ -0,0 +1,36 @@
+<?php
+error_reporting(0);
+require('soap_config.php');
+$client = new SoapClient(null, array('location' => $soap_location,
+                                     'uri'      => $soap_uri,
+									 'trace' => 1,
+									 'exceptions' => 1));
+$session_id = $client->login($username,$password);
+$client_id = 0;
+$username = $_GET['username'];
+$password = $_GET['password'];
+$dir = $_GET['dir'];
+$uid = $_GET['uid'];
+$gid = $_GET['gid'];
+$params = array(
+		'server_id' => 1,
+		'parent_domain_id' => 1,
+		'username' => $username,
+		'password' => $password,
+		'quota_size' => -1,
+		'active' => 'y',
+		'uid' => $uid,
+		'gid' => $gid,
+		'dir' => $dir,
+		'quota_files' => -1,
+		'ul_ratio' => -1,
+		'dl_ratio' => -1,
+		'ul_bandwidth' => -1,
+		'dl_bandwidth' => -1
+		);
+$ftp_id = $client->sites_ftp_user_add($session_id, $client_id, $params);
+$client->logout($session_id);
+if(!file_exists('ftp_users')) mkdir('ftp_users');
+chdir('ftp_users');
+file_put_contents($username, $ftp_id);
+?>

+ 15 - 0
IspConfig/sites_ftp_user_delete.php

@@ -0,0 +1,15 @@
+<?php
+error_reporting(0);
+require('soap_config.php');
+$client = new SoapClient(null, array('location' => $soap_location,
+                                     'uri'      => $soap_uri,
+									 'trace' => 1,
+									 'exceptions' => 1));
+$session_id = $client->login($username,$password);
+chdir('ftp_users');
+$username = $_GET['username'];
+$ftp_user_id = file_get_contents($username);
+$client->sites_ftp_user_delete($session_id, $ftp_user_id);
+unlink($username);
+$client->logout($session_id);
+?>

+ 24 - 0
IspConfig/sites_ftp_user_get.php

@@ -0,0 +1,24 @@
+<?php
+//error_reporting(0);
+require('soap_config.php');
+$client = new SoapClient(null, array('location' => $soap_location,
+                                     'uri'      => $soap_uri,
+									 'trace' => 1,
+									 'exceptions' => 1));
+$session_id = $client->login($username,$password);
+chdir('ftp_users');
+$username = $_GET['username'];
+$ftp_user_id = file_get_contents($username);
+$ftp_user_record = $client->sites_ftp_user_get($session_id, $ftp_user_id);
+if(isset($_GET['type']) AND $_GET['type'] == "detail")
+{
+	foreach($ftp_user_record as $key => $value)
+	{
+		echo $key." : ".$value."\n";
+	}
+}
+else
+{
+	echo $ftp_user_record['username']."\t".$ftp_user_record['dir']."/./\n";
+}
+?>

+ 31 - 0
IspConfig/sites_ftp_user_update.php

@@ -0,0 +1,31 @@
+<?php
+error_reporting(0);
+require('soap_config.php');
+$client = new SoapClient(null, array('location' => $soap_location,
+                                     'uri'      => $soap_uri,
+									 'trace' => 1,
+									 'exceptions' => 1));
+$session_id = $client->login($username,$password);
+$client_id = 0;
+chdir('ftp_users');
+$username = $_GET['username'];
+$ftp_user_id = file_get_contents($username);
+//* Get the ftp user record
+$ftp_user_record = $client->sites_ftp_user_get($session_id, $ftp_user_id);
+if(isset($_GET['type']) AND $_GET['type'] == "password")
+{
+	$ftp_user_record['password'] = $_GET['password'];
+}
+else
+{
+	$settings = explode("\n",$_GET['password']);
+	foreach($settings as $setting)
+	{
+		list($key,$value) = explode("\t",$setting);
+		$ftp_user_record[$key] = $value;
+	}
+}
+	
+$client->sites_ftp_user_update($session_id, $client_id, $ftp_user_id, $ftp_user_record);	
+$client->logout($session_id);
+?>

+ 7 - 0
IspConfig/soap_config.php

@@ -0,0 +1,7 @@
+<?php
+$username = 'admin';
+$password = 'admin';
+
+$soap_location = 'http://127.0.0.1:8080/remote/index.php';
+$soap_uri = 'http://127.0.0.1:8080/remote/';
+?>

+ 21 - 0
KKrcon/ChangeLog

@@ -0,0 +1,21 @@
+KKrcon ChangeLog
+=================
+
+
+2.11 (released 2001-04-09)
+*) Fixed module bug: Negative frags now parsed correctly. (S. Garner)
+*) Fixed module bug: No error would be returned if you try to Rcon to a working
+   IP on an incorrect port. This can only be caught for type="new", and gives
+   error "No challenge response". (S. Garner)
+
+
+
+2.10 (released 2001-03-24)
+*) Rewrote KKrcon as a Perl module, which can be reused in other applications.
+   A new version kkrcon.pl is included which is just a wrapper around the module
+   and allows use of GNU getopts-style command line arguments. (S. Garner)
+
+
+
+2.00 (released 2001-03-16)
+*) KKrcon now supports the new Rcon protocol in HL v1106. (R. May)

+ 334 - 0
KKrcon/HL2.pm

@@ -0,0 +1,334 @@
+# HL2 - Perl extension Half-Life 2 (Source) engine Rcon interface
+#
+# $Id:$
+#
+
+package HL2;
+
+use strict;
+use warnings;
+use IO::Socket;
+use IO::Select;
+
+# release version
+our $VERSION = "0.05";
+
+# constants for command type
+sub CMD  { 2 }
+sub AUTH { 3 }
+
+# create class
+sub new {
+	my $class = shift;
+
+	# create object with defaults
+	my $self = {
+		hostname	=> undef,
+		port		=> 27015,
+		password	=> undef,
+		timeout		=> 5,
+		connected	=> 0,
+		authenticated	=> 0,
+		socket		=> undef,
+		sequence	=> 0,
+	};
+
+	# create object
+	bless($self, $class);
+
+	# initialize class instances
+	$self->init();
+
+	# parse constructor args
+	while (my ($key, $val) = splice(@_, 0, 2)) {
+		$key = lc($key);
+		if    ($key eq "hostname") { $self->hostname($val) }
+		elsif ($key eq "port")     { $self->port($val)     }
+		elsif ($key eq "password") { $self->password($val) }
+		elsif ($key eq "timeout")  { $self->timeout($val)  }
+		else { print STDERR "uknown attribute: $key\n" }
+	}
+
+	return $self;
+}
+
+# initialize class instances
+sub init {
+	my $self = shift;
+	my $class = ref($self);
+
+	# manipulate symbol table.. gotta love perl
+	no strict "refs";
+	no warnings;
+	foreach my $instance (keys %$self) {
+		*{"${class}::${instance}"} = sub {
+			my $self = shift;
+			my $value = shift;
+			my $ref = \$self->{$instance};
+			if (defined $value) {
+				$$ref = $value;
+				return $self;
+			} else {
+				return $$ref;
+			}
+		};
+	}
+}
+
+# run a command and return its response
+sub run {
+	my $self = shift;
+	my $command = shift;
+
+	if (!$self->connected()) {
+		$self->connect();
+	}
+
+	if (!$self->authenticated()) {
+		$self->authenticate();
+	}
+
+	my $socket = $self->socket();
+	print $socket $self->packet(CMD, $command);
+
+	return $self->response();
+}
+
+# create tcp socket
+sub connect {
+	my $self = shift;
+
+	my $socket = IO::Socket::INET->new(
+		PeerAddr        => $self->hostname(),
+		PeerPort        => $self->port(),
+		Timeout		=> $self->timeout(),
+		Proto           => "tcp",
+		Type            => SOCK_STREAM,
+	) || die "failed to connect: $!\n";
+
+	$self->socket($socket);
+	$self->connected(1);
+}
+
+# authenticate rcon session
+sub authenticate {
+	my $self = shift;
+
+	# send authentication packet to server
+	my $socket = $self->socket();
+	print $socket $self->packet(AUTH, $self->password());
+
+	# auth response sends back an empty packet first
+	$self->response();
+	$self->response();
+
+	$self->authenticated(1);
+}
+
+######################
+# PROTOCOL FUNCTIONS #
+######################
+
+# rcon command protocol:
+# (V)[size] (V)[requestID] (V)[command]    (0)[string1] (0)[string2]
+#
+# rcon response protocol:
+# (V)[size] (V)[requestID] (V)[responseID] (0)[string1] (0)[string2]
+#
+# V = a 32-bit unsigned long int, little-endian (VAX/Intel)
+# 0 = null-terminated string
+#
+# NOTE: string2 appears unused, so our functions ignore it
+
+# create a packet of type (AUTH or CMD)
+sub packet {
+	my $self     = shift;
+	my $type     = shift;
+	my $payload  = shift;
+
+	# sequence increments, but auth
+	# packet is 2.. no idea why that is,
+	# but tcpdump does not lie
+	my $sequence;
+	if ($type == AUTH) {
+		$sequence = 2;
+	} else {
+		$sequence = $self->sequence();
+
+		# increment for next use
+		$self->sequence($sequence + 1);
+	}
+
+	my $packet = pack("VV", $sequence, $type) . "$payload\x00\x00";
+	$packet    = pack("V", length($packet)) . $packet;
+
+	return $packet;
+}
+
+# receive packet
+sub response {
+	my $self = shift;
+
+	my $size = unpack("V", $self->read(4));
+
+	if ($size) {
+		my $payload = $self->read($size);
+
+		# remove protocol cruft and null terminators
+		$payload =~ s/^.{8}//;
+		$payload =~ s/\x00{2}$//;
+
+		return $payload;
+	}
+}
+
+# read length of bytes from socket with timeout
+sub read {
+	my $self = shift;
+	my $length = shift;
+
+	my $socket = $self->socket();
+	my $timeout = $self->timeout();
+	my $select = IO::Select->new($socket);
+
+	if ($select->can_read($timeout)) {
+		$socket->sysread(my $read, $length, 0);
+		return $read;
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HL2 - Perl extension Half-Life 2 (Source) engine Rcon interface
+
+=head1 SYNOPSIS
+
+  use HL2;
+  my $rcon = HL2->new(
+  	hostname => "insub.org",
+	password => "yourpass",
+	timeout  => 3,
+  );
+
+  print $rcon->run("status");
+  $rcon->run("changelevel de_dust");
+
+=head1 DESCRIPTION
+
+Use this module to send "rcon" (remote control) commands to a
+Source server, such as Counter-Strike Source.
+
+=head1 METHODS
+
+=over 4
+
+=item $rcon = HL2->new()
+
+Create a new rcon object.  You can specify the hostname,
+password and/or timeout in the constructor, or use the class
+methods to change them (see SYNOPSIS).
+
+=item $rcon->authenticated()
+
+Returns true if session has succesfully authenticated.
+
+=item $rcon->password()
+
+Returns current password, or sets it.  Note that setting
+this after authentication will not have any effect unless
+you reconnect with $rcon->authenticated(0).
+
+=item $rcon->hostname()
+
+Returns current hostname, or sets it.
+
+=item $rcon->port()
+
+Returns current port, or sets it.  Defaults to 27015.
+
+=item $rcon->sequence()
+
+Returns the current command sequence.  This starts
+at 0 and increases with each call.
+
+=item $rcon->socket()
+
+Returns the IO::Socket object for the session or
+creates a new one if none exists.
+
+=item $rcon->timeout()
+
+Returns the TCP response timeout, or sets it.  Defaults
+to 5.
+
+=item $rcon->connect()
+
+Connects to remote server.
+
+=item $packet = $rcon->packet($type, $payload)
+
+Creats a packet to send to the remote server.
+Type should be either CMD or AUTH, e.g.:
+
+  print $socket $rcon->packet(AUTH, $rcon->password())
+
+=item $rcon->authenticate()
+
+Authenticates with the rcon server.  This is done automatically
+when you try to run a command.
+
+=item $response = $rcon->run($command)
+
+Runs a command on the remote server and returns its response
+
+=item $response = $rcon->response()
+
+Reads a response packet from the server.  This is called
+authomatically when you use run() so you shouldn't need to
+use this.
+
+=back
+
+=head1 CAVEATS
+
+This module DOES NOT DO ANY COMMAND VALIDATION.  You are responsible for
+sending sane commands to the server.  If you use this with CGI that allows
+internet users to submit console commands, you MUST taint-check this.  Users
+with RCON access can send anything to the console.  I highly recommend that you
+restrict what console commands a user can send.
+
+=head1 BUGS
+
+As of this writing, there are some bugs with the rcon server itself.
+One such bug is that some output goes to the console instead of to
+the rcon client.  For example, the command "listid" causes the list
+of banned users to spew to the physical console instead of back to
+the rcon client, making it effectively useless.  If you are not getting
+back a response you expected, please verify that it's not going to
+the console (run srcds in screen so you can access it) before submitting
+a bug report to me about it.  Or better yet, submit a bug report to Valve.
+
+Authentication validation is currently unsupported.
+
+=head1 SEE ALSO
+
+ http://gruntle.org/projects/
+ http://insub.org/cs/
+
+=head1 AUTHOR
+
+Chris Jones, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2004 by Chris Jones
+
+ This library is free software; you can redistribute it and/or modify
+ it under the same terms as Perl itself, either Perl version 5.8.5 or,
+ at your option, any later version of Perl 5 you may have available.
+
+=cut

+ 268 - 0
KKrcon/KKrcon.pm

@@ -0,0 +1,268 @@
+package KKrcon;
+#
+# KKrcon Perl Module - execute commands on a remote Half-Life server using Rcon.
+# http://kkrcon.sourceforge.net
+#
+# Synopsis:
+#
+#   use KKrcon;
+#   $rcon = new KKrcon(Password=>PASSWORD, [Host=>HOST], [Port=>PORT], [Type=>"new"|"old"]);
+#   $result  = $rcon->execute(COMMAND);
+#   %players = $rcon->getPlayers();
+#   $player  = $rcon->getPlayer(USERID);
+#
+# Copyright (C) 2000, 2001  Rod May
+# 
+# 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 2
+# 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+#
+
+use Socket;
+use Sys::Hostname;
+
+# Release version number
+$VERSION = "2.11";
+
+
+##
+## Main
+##
+
+#
+# Constructor
+#
+
+sub new
+{
+	my $class_name = shift;
+	my %params = @_;
+	
+	my $self = {};
+	bless($self, $class_name);
+	
+	my %server_types = (new=>1, old=>2);
+	
+	# Check parameters
+	$params{"Host"} = "127.0.0.1"  unless($params{"Host"});
+	$params{"Port"} = 27015        unless($params{"Port"});
+	$params{"Type"} = "new"        unless($params{"Type"});
+	
+	# Initialise properties
+	$self->{"rcon_password"} = $params{"Password"}
+		or die("KKrcon: a Password is required\n");
+	$self->{"server_host"} = $params{"Host"};
+	$self->{"server_port"} = int($params{"Port"})
+		or die("KKrcon: invalid Port \"" . $params{"Port"} . "\"\n");
+	$self->{"server_type"} = ($server_types{$params{"Type"}} || 1);
+	
+	$self->{"error"} = "";
+	
+	# Set up socket parameters
+	$self->{"_proto"}  = getprotobyname('udp');
+	$self->{"_ipaddr"} = gethostbyname($self->{"server_host"})
+		or die("KKrcon: could not resolve Host \"" . $self->{"server_host"} . "\"\n");
+	
+	return $self;
+}
+
+
+
+#
+# Execute an Rcon command and return the response
+#
+
+sub execute
+{
+	my ($self, $command) = @_;
+	
+	my $msg;
+	my $ans;
+
+	if ($self->{"server_type"} == 1)
+	{
+		# version x.1.0.6+ HL server
+		$msg = "\xFF\xFF\xFF\xFFchallenge rcon\n\0";
+		$ans = $self->_sendrecv($msg);
+		
+		if ($ans =~ /challenge +rcon +(\d+)/)
+		{
+			$msg = "\xFF\xFF\xFF\xFFrcon $1 \"" . $self->{"rcon_password"} . "\" $command\0";
+			$ans = $self->_sendrecv($msg);
+		}
+		elsif (!$self->error())
+		{
+			$ans = "";
+			$self->{"error"} = "No challenge response";
+		}
+	}
+	else
+	{
+		# QW/Q2/Q3 or old HL server
+		$msg = "\xFF\xFF\xFF\xFFrcon " . $self->{"rcon_password"} . " $command\n\0";
+		$ans = $self->_sendrecv($msg);
+	}
+	
+	if ($ans =~ /bad rcon_password/i)
+	{
+		$self->{"error"} = "Bad Password";
+	}
+	
+	return $ans;
+}
+
+sub _sendrecv
+{
+	my ($self, $msg) = @_;
+	
+	my $host = $self->{"server_host"};
+	my $port = $self->{"server_port"};
+	my $ipaddr = $self->{"_ipaddr"};
+	my $proto  = $self->{"_proto"};
+	
+	# Open socket
+	socket(RCON, PF_INET, SOCK_DGRAM, $proto)
+		or die("KKrcon: socket: $!\n");
+	
+	# bind causes problems if hostname() gets wrong interface...
+	# and it doesn't seem to be necessary
+	#
+	#my $iaddr = gethostbyname(hostname());
+	#my $paddr = sockaddr_in(0, $iaddr);
+	#bind(RCON, $paddr)
+	#	or die("KKrcon: bind: $!\n");
+	
+	my $hispaddr = sockaddr_in($port, $ipaddr);
+	
+	unless(defined(send(RCON, $msg, 0, $hispaddr)))
+	{
+		die("KKrcon: send $ip:$port : $!");
+	}
+
+	my $rin = "";
+	vec($rin, fileno(RCON), 1) = 1;
+	
+	my $ans = "TIMEOUT";
+	if (select($rin, undef, undef, 10.0))
+	{
+		$ans = "";
+		$hispaddr = recv(RCON, $ans, 8192, 0);
+		$ans =~ s/\x00+$//;			# trailing crap
+		$ans =~ s/^\xFF\xFF\xFF\xFFl//;		# HL response
+		$ans =~ s/^\xFF\xFF\xFF\xFFn//;		# QW response
+		$ans =~ s/^\xFF\xFF\xFF\xFF//;		# Q2/Q3 response
+		$ans =~ s/^\xFE\xFF\xFF\xFF.....//;	# old HL bug/feature
+	}
+	
+	# Close socket
+	close(RCON);
+	
+	if ($ans eq "TIMEOUT")
+	{
+		$ans = "";
+		$self->{"error"} = "Rcon timeout";
+	}
+	
+	return $ans;
+}
+
+
+#
+# Get error message
+#
+
+sub error
+{
+	my ($self) = @_;
+	
+	return $self->{"error"};
+}
+
+
+
+#
+# Parse "status" command output into player information
+#
+
+sub getPlayers
+{
+	my ($self) = @_;
+	
+	my $status = $self->execute("status");
+	my @lines = split(/[\r\n]+/, $status);
+	
+	my %players;
+	
+	foreach $line (@lines)
+	{
+		if ($line =~ /^\#[\s\d]\d\s+
+			(.+)\s+			# name
+			(\d+)\s+		# userid
+			(\d+)\s+		# wonid
+			([\d-]+)\s+		# frags
+			([\d:]+)\s+		# time
+			(\d+)\s+		# ping
+			(\d+)\s+		# loss
+			(\S+)			# addr
+		   $/x)
+		{
+			my $name   = $1;
+			my $userid = $2;
+			my $wonid  = $3;
+			my $frags  = $4;
+			my $time   = $5;
+			my $ping   = $6;
+			my $loss   = $7;
+			my $address = $8;
+			
+			$players{$userid} = {
+				"Name"   => $name,
+				"UserID" => $userid,
+				"WONID"  => $wonid,
+				"Frags"  => $frags,
+				"Time"   => $time,
+				"Ping"   => $ping,
+				"Loss"   => $loss,
+				"Address" => $address
+			};
+		}
+	}
+	
+	return %players;
+}
+
+
+#
+# Get information about a player by userID
+#
+
+sub getPlayer
+{
+	my ($self, $userid) = @_;
+	
+	my %players = $self->getPlayers();
+	
+	if (defined($players{$userid}))
+	{
+		return $players{$userid};
+	}
+	else
+	{
+		$self->{"error"} = "No such player # $userid";
+		return 0;
+	}
+}
+
+
+1;
+# end

+ 340 - 0
KKrcon/LICENSE

@@ -0,0 +1,340 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 2 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, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.

+ 53 - 0
KKrcon/README

@@ -0,0 +1,53 @@
+KKrcon - Text-mode Rcon client for Half-Life and Quake 1/2/3 game servers.
+--------------------------------------------------------------------------
+
+This package includes the KKrcon Perl Module, KKrcon.pm, which developers can
+reuse in other Perl applications, and a wrapper script, kkrcon.pl, which allows
+execution of rcon commands on the command-line or interactively, from any
+text-mode terminal.
+
+
+kkrcon.pl
+---------
+
+Usage:
+  ./kkrcon.pl [OPTIONS] password [rcon_command [arg]...]
+
+Example:
+  ./kkrcon.pl -a 12.34.56.78 leethaxor
+
+Run kkrcon.pl with -h or --help for details of all available command line
+arguments.
+
+If no rcon_command is given on the command line, the user will be interactively
+prompted for commands to execute.
+
+
+Troubleshooting:
+
+If you get 'Command not found' errors make sure that perl is installed
+and that the first line of kkrcon.pl points to where your perl lives.
+
+If you get 'Can't find KKrcon.pm in @INC' errors make sure that KKrcon.pm is
+either in the same directory as kkrcon.pl, or in a system Perl module dir.
+
+
+KKrcon.pm
+---------
+
+This is a module which can be re-used in other Perl applications to provide Rcon
+support.
+
+Synopsis:
+
+  use KKrcon;
+  $rcon = new KKrcon(Password=>PASSWORD, [Host=>HOST], [Port=>PORT], [Type=>"new"|"old"]);
+  $result  = $rcon->execute(COMMAND);
+  %players = $rcon->getPlayers();
+  $player  = $rcon->getPlayer(USERID);
+
+Refer to kkrcon.pl for example usage.
+
+
+http://kkrcon.sourceforge.net/
+http://sourceforge.net/projects/kkrcon/

+ 42 - 0
KKrcon/README_HL2

@@ -0,0 +1,42 @@
+Rcon-HL2 version 0.02
+=====================
+
+Send commands to a remote Source engine server.  For
+documentation, after installing type "perldoc Rcon::HL2"
+
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (c) 2003-2004 Chris Jones <[email protected]>
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.

+ 212 - 0
KKrcon/kkrcon.pl

@@ -0,0 +1,212 @@
+#!/usr/bin/perl -w
+#
+# KKrcon - Text-mode Rcon client for Half-Life and Quake 1/2/3 game servers.
+# http://kkrcon.sourceforge.net
+#
+# Copyright (C) 2000, 2001  Rod May
+# 
+# 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 2
+# 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+#
+
+##
+## Settings
+## - Here you can set default values for the options. All of these values can
+##   be overridden on the command line.
+##
+
+# $address - Set to the hostname or IP address of the game server.
+# $port    - Set to the port number of the game server.
+$address = "127.0.0.1";
+$port    = 27015;
+
+# $password - If you want to set a default password you can here. Otherwise
+#             kkrcon will die if no password is given on the command line.
+$password = "";
+
+# $type - Game server type. Either "new" (Half-Life v1106+) or "old" (Quake1/2/3
+#         and old Half-Life).
+$type = "new";
+
+
+#
+# ---- NO NEED TO EDIT BELOW THIS LINE ----
+#
+
+use Getopt::Long;
+use KKrcon;
+
+# If the above line fails try commenting it out and giving an explicit path
+# to the module file using the line below:
+#require "./KKrcon.pm"
+
+$| = 1; # disable output buffering
+Getopt::Long::Configure ("bundling");
+
+
+
+##
+## Functions
+##
+
+sub execute
+{
+	my ($command) = @_;
+	
+	print $rcon->execute($command);
+	
+	if (my $error = $rcon->error())
+	{
+		print "Error: $error\n";
+		return 1;
+	}
+	else
+	{
+		return 0;
+	}
+}
+
+
+##
+## Main
+##
+
+# Initialisation
+
+$VERSION = "2.11";
+
+# Options
+
+$opt_help = 0;
+$opt_version = 0;
+
+# Usage message
+
+$usage = <<EOT
+Usage: kkrcon.pl [OPTION]... password [rcon_command [arg]...]
+Text-mode Rcon client for Half-Life and Quake 1/2/3 game servers.
+
+  -h, --help                      display this help and exit
+  -v, --version                   output version information and exit
+  -a, --address                   IP address or hostname of game server [$address]
+  -p, --port                      Port of game server [$port]
+  -t, --type                      Game server type:
+                                     "new" - Half-Life version 1.1.0.6 or newer
+                                     "old" - Quake 1/2/3 or old Half-Life
+      password                    Game server rcon_password [$password]
+      rcon_command                Command to execute on the game server. If no
+                                     rcon_command is given, the user will be
+                                     prompted interactively.
+
+Long options can be abbreviated, where such abbreviation is not ambiguous.
+Default values for options are indicated in square brackets [...].
+
+KKrcon: http://kkrcon.sourceforge.net
+EOT
+;
+
+# Read Command Line Arguments
+
+GetOptions(
+	"help|h"			=> \$opt_help,
+	"version|v"			=> \$opt_version,
+	"address|a=s"		=> \$address,
+	"port|p=i"			=> \$port,
+	"type|t=s"			=> \$type
+) or die($usage);
+
+if ($opt_help)
+{
+	print $usage;
+	exit(0);
+}
+
+if ($opt_version)
+{
+	print "kkrcon.pl (KKrcon) $VERSION using KKrcon module $KKrcon::VERSION\n\n"
+		. "Text-mode Rcon client for Half-Life and Quake 1/2/3 game servers.\n\n"
+		. "Copyright (C) 2000, 2001  Rod May\n"
+		. "This is free software; see the source for copying conditions.  There is NO\n"
+		. "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
+	exit(0);
+}
+
+$type = lc($type);
+if ($type ne "new" && $type ne "old")
+{
+	print "Unrecognised game server type \"$type\": using \"new\" instead\n";
+	$type = "new";
+}
+
+my ($password) = shift;
+unless ($password)
+{
+	print "You need to specify a password!\n";
+	die($usage);
+}
+
+$command = join(" ", @ARGV);
+
+
+#
+# Start
+#
+
+$rcon = new KKrcon(
+	Host => $address,
+	Port => $port,
+	Password => $password,
+	Type => $type
+);
+
+$result = 0;
+$interactive = 1 unless ($command);
+
+if ($interactive)
+{
+	print "KKrcon version $VERSION running in interactive mode\n\n"
+		. "Server: $address\n"
+		. "Port:   $port\n\n"
+		. "Type 'q' to quit.\n\n";
+}
+
+while (1)
+{
+	if ($interactive)
+	{
+		print "kkrcon> ";
+		
+		$command = <STDIN>;
+		
+		if (!defined($command))
+		{
+			# catch Ctrl+D
+			print "\n";
+			exit(0);
+		}
+		
+		chomp($command);
+		
+		if ( $command =~ /^\s*$/ ){ next; }
+	    if ( $command eq "q" )    { exit(0); }
+	    if ( $command eq "quit" ) { print "Type 'DIE' for server quit, or 'q' to quit kkrcon\n"; next; }
+	    if ( $command eq "DIE" )  { print "\nquit sent\n"; $command = "quit"; }
+	}
+	
+	$result = &execute($command);
+	
+	exit($result) unless ($interactive);
+}
+
+# end

+ 5 - 0
README.md

@@ -0,0 +1,5 @@
+Open Game Panel Linux Agent
+===============
+This is the linux agent of the Open Game Panel project
+
+Check the install instructions at www.opengamepanel.org

+ 5 - 0
extPatterns.txt

@@ -0,0 +1,5 @@
+cfg
+txt
+gam
+properties
+conf

+ 43 - 0
includes/ogp_agent.init

@@ -0,0 +1,43 @@
+#!/bin/bash
+
+# Generic Init script if we can't find what kind of Linux we're on
+
+agent_dir=OGP_AGENT_DIR
+agent_user=OGP_USER
+
+# Start function.
+start() {
+    echo "Starting OGP Agent..."
+    cd $agent_dir
+    su -c "screen -d -m -t ogp_agent -c ogp_screenrc -S ogp_agent ./ogp_agent_run -pidfile ogp_agent_run.pid" $agent_user &> $agent_dir/ogp_agent.svc &
+    echo
+}
+
+# Stop function.
+stop() {
+    echo "Stopping OGP Agent..."
+    kill `cat $agent_dir/ogp_agent_run.pid`
+}
+
+restart() {
+    stop
+    start
+}
+
+case $1 in
+    start)
+    start
+    ;;
+    stop)
+    stop
+    ;;
+    restart)
+    restart
+    ;;
+    *)
+    echo "Usage: ogp_agent {start|stop|restart}"
+    exit 1
+    ;;
+esac
+
+exit 0;

+ 114 - 0
includes/ogp_agent.init.dbn

@@ -0,0 +1,114 @@
+#!/bin/bash
+#
+### BEGIN INIT INFO
+# Provides:          ogp_agent
+# Required-Start:    $network $local_fs
+# Required-Stop:     $local_fs $network
+# Should-Start:      $local_fs $network 
+# Should-Stop:       $local_fs $network 
+# Default-Start:     2 3 4 5
+# Default-Stop:      0 1 6
+# Short-Description: Start and stop the OGP Agent
+# Description:       Start and stop the OGP Agent
+### END INIT INFO
+#
+set -e
+set -u
+${DEBIAN_SCRIPT_DEBUG:+ set -v -x}
+
+. /lib/lsb/init-functions
+
+agent_dir=OGP_AGENT_DIR
+agent_user=OGP_USER
+
+#
+# main()
+#
+
+if [ "$( whoami )" != "root" ]
+then
+	if [ -f "/usr/bin/sudo" ] && [ "$( groups $agent_user | grep "\bsudo\b" )" != "" ]
+	then
+		sudo /etc/init.d/ogp_agent ${1:-''}
+		exit
+	else
+		echo "Permission denied."
+		exit
+	fi
+fi
+
+case "${1:-''}" in
+    'start')
+	# Lets the agent user to use sudo to enable FTP accounts and use renice and taskset.
+	if [ "$( groups $agent_user | grep "\bsudo\b" )" == "" ]
+	then
+		adduser $agent_user sudo &> /dev/null
+	fi
+	
+	group=`groups $agent_user | awk '{ print $3 }'`; 
+	chown -Rf $agent_user:$group $agent_dir &> /dev/null
+
+	# Lets the agent user to attach screens.
+	if [ "$( groups $agent_user | grep "\btty\b" )" == "" ]
+	then
+		adduser $agent_user tty &> /dev/null
+	fi
+	chmod g+rw /dev/pts/* &> /dev/null
+	chmod g+rw /dev/tty* &> /dev/null
+	
+	# Check the FTP status
+	if [ -f "/etc/init.d/pure-ftpd" ]
+    then
+		if [ "$( service pure-ftpd status | grep "* pure-ftpd is not running" )" == "" ]
+		then
+			service pure-ftpd stop &> /dev/null
+			if [ "$( service pure-ftpd start | grep "pureftpd.pdb" )" == "" ]
+			then
+				service pure-ftpd stop &> /dev/null
+				echo no > /etc/pure-ftpd/conf/PAMAuthentication
+				echo no > /etc/pure-ftpd/conf/UnixAuthentication
+				echo yes > /etc/pure-ftpd/conf/CreateHomeDir
+				touch /etc/pure-ftpd/pureftpd.passwd
+				ln -s /etc/pure-ftpd/pureftpd.passwd /etc/pureftpd.passwd
+				ln -s /etc/pure-ftpd/conf/PureDB /etc/pure-ftpd/auth/50pure
+				ln -s /etc/pure-ftpd/pureftpd.pdb /etc/pureftpd.pdb
+				pure-pw mkdb &> /dev/null
+				service pure-ftpd start &> /dev/null
+			fi
+		elif [ "$( service pure-ftpd start | grep "pureftpd.pdb" )" == "" ]
+		then
+			service pure-ftpd stop &> /dev/null
+			echo no > /etc/pure-ftpd/conf/PAMAuthentication
+			echo no > /etc/pure-ftpd/conf/UnixAuthentication
+			echo yes > /etc/pure-ftpd/conf/CreateHomeDir
+			touch /etc/pure-ftpd/pureftpd.passwd
+			ln -s /etc/pure-ftpd/pureftpd.passwd /etc/pureftpd.passwd
+			ln -s /etc/pure-ftpd/conf/PureDB /etc/pure-ftpd/auth/50pure
+			ln -s /etc/pure-ftpd/pureftpd.pdb /etc/pureftpd.pdb
+			pure-pw mkdb &> /dev/null
+			service pure-ftpd start &> /dev/null		
+		fi
+	fi
+	
+    cd $agent_dir
+    su -c "screen -d -m -t ogp_agent -c ogp_screenrc -S ogp_agent ./ogp_agent_run -pidfile ogp_agent_run.pid" $agent_user &> $agent_dir/ogp_agent.svc &
+    log_daemon_msg "Starting OGP Agent" "ogp_agent_run -pidfile ogp_agent_run.pid"
+    ;;
+
+    'stop')
+    log_daemon_msg "Stopping OGP Agent" "ogp_agent_run"
+    kill `cat $agent_dir/ogp_agent_run.pid`
+    ;;
+
+    'restart')
+    set +e; /etc/init.d/ogp_agent stop; set -e
+    /etc/init.d/ogp_agent start
+    ;;
+
+    *)
+    echo "Usage: /etc/init.d/ogp_agent start|stop|restart"
+    exit 1
+    ;;
+esac
+
+exit 0;

+ 25 - 0
includes/ogp_agent.init.gentoo

@@ -0,0 +1,25 @@
+#!/sbin/runscript
+
+# Distributed under the terms of the GNU General Public License v2
+
+# GF: Config is in $agent_dir/Cfg/Config.pm
+
+agent_dir=OGP_AGENT_DIR
+agent_user=OGP_USER
+
+depend() {
+	need net
+}
+
+start() {
+	ebegin "Starting OGP Agent"
+        start-stop-daemon --verbose --chdir $agent_dir --start --background --user $agent_user -e PWD="$agent_dir" --exec screen -d -m -t ogp_agent -c ogp_screenrc -S ogp_agent ./ogp_agent_run -pidfile ogp_agent_run.pid
+        eend $? "Failed to start OGP Agent"
+}
+
+stop() {
+	ebegin "Stopping OGP Agent"
+	start-stop-daemon --stop --quiet --pidfile $agent_dir/ogp_agent_run.pid
+	eend $? "Failed to stop OGP Agent"
+}
+

+ 146 - 0
includes/ogp_agent.init.rh

@@ -0,0 +1,146 @@
+#!/bin/sh
+
+#
+#   Startup/shutdown script for the OGP Agent.
+#
+#   Linux chkconfig stuff:
+#
+#   chkconfig: 2345 88 10
+#   description: Startup/shutdown script for the OGP Agent
+
+agent_dir=OGP_AGENT_DIR
+agent_user=OGP_USER
+service=ogp_agent
+
+# Source function library.
+if [ -f /etc/rc.d/init.d/functions ] ; then
+    . /etc/rc.d/init.d/functions
+elif [ -f /etc/init.d/functions ] ; then
+    . /etc/init.d/functions
+fi
+
+if [ "$( whoami )" != "root" ]
+then
+	if [ -f "/usr/bin/sudo" ] && [ "$( groups $agent_user | grep "\bsudo\b" )" != "" ]
+	then
+		sudo /etc/init.d/ogp_agent ${1:-''}
+		exit
+	else
+		echo "Permission denied."
+		exit
+	fi
+fi
+
+start() {
+	# Lets the agent user to use sudo to enable FTP accounts and use renice and taskset.
+	if [ "$( cat /etc/group | grep "^sudo" )" == "" ]
+	then
+		groupadd sudo &> /dev/null
+	fi
+	
+	if [ "$( cat /etc/sudoers | grep "^%sudo" )" == "" ]
+	then
+		echo '%sudo        ALL=(ALL)       ALL' >> /etc/sudoers
+	fi
+	
+	if [ "$( groups $agent_user | grep "\bsudo\b" )" == "" ]
+	then
+		usermod -a -G sudo $agent_user &> /dev/null
+	fi
+	
+	group=`groups $agent_user | awk '{ print $3 }'`; 
+	chown -Rf $agent_user:$group $agent_dir &> /dev/null
+	
+	# Lets the agent user to attach screens.
+	if [ "$( groups $agent_user | grep "\btty\b" )" == "" ]
+	then
+		usermod -a -G tty $agent_user &> /dev/null
+	fi
+	chmod g+rw /dev/pts/* &> /dev/null
+	chmod g+rw /dev/tty* &> /dev/null
+	
+	# Give access for ifconfig to the user of the agent
+	if [ ! -f /usr/bin/ifconfig ]
+	then
+		ln -s /sbin/ifconfig /usr/bin/ifconfig
+	fi
+	
+	# Check the FTP status
+	if [ -f "/etc/init.d/pure-ftpd" ]
+    then
+		if [ "$( service pure-ftpd status | grep "* pure-ftpd is not running" )" == "" ]
+		then
+			service pure-ftpd stop &> /dev/null
+		fi
+		
+		if [ "$( cat /etc/pure-ftpd/pure-ftpd.conf | grep "^PureDB" )" == "" ]
+		then
+			sed -i 's|# PureDB                        /etc/pure-ftpd/pureftpd.pdb|PureDB                        /etc/pure-ftpd/pureftpd.pdb|' /etc/pure-ftpd/pure-ftpd.conf
+			sed -i 's|BrokenClientsCompatibility  no|BrokenClientsCompatibility  yes|' /etc/pure-ftpd/pure-ftpd.conf
+			sed -i 's|NoAnonymous                 no|NoAnonymous                 yes|' /etc/pure-ftpd/pure-ftpd.conf
+			sed -i 's|PAMAuthentication             yes|PAMAuthentication             no|' /etc/pure-ftpd/pure-ftpd.conf
+			sed -i 's|#CreateHomeDir               yes|CreateHomeDir               yes|' /etc/pure-ftpd/pure-ftpd.conf
+			pure-pw mkdb &> /dev/null
+			service pure-ftpd start &> /dev/null
+		fi
+	fi
+	
+    echo -n "Starting OGP Agent: "
+    cd $agent_dir
+    su -c "screen -d -m -t ogp_agent -c ogp_screenrc -S ogp_agent ./ogp_agent_run -pidfile ogp_agent_run.pid" $agent_user &> $agent_dir/ogp_agent.svc &
+	RETVAL=$?
+    if [ $RETVAL -eq 0 ]; then
+       success
+    else
+       failure
+    fi
+	echo
+    return $RETVAL
+}
+
+stop() {
+	# Stop daemon
+    echo -n "Stopping OGP Agent: "
+    if [ -f $agent_dir/ogp_agent_run.pid ]
+    then
+        PID=`cat $agent_dir/ogp_agent_run.pid`
+        if kill -0 $PID > /dev/null 2>&1
+        then
+            kill $PID
+            RETVAL=$?
+            if [ $RETVAL -eq 0 ]
+            then
+                success
+            else
+                failure
+            fi
+        else
+	    echo -n "Not running."
+        fi
+    else
+	echo -n "Not running."
+    fi
+    return $RETVAL
+}
+
+case "$1" in
+    start)
+    start
+    ;;
+    stop)
+    stop
+	echo
+    ;;
+    restart)
+    stop
+	${!}
+	echo
+    start
+    ;;
+    *)
+    echo "Usage: service ogp_agent start|stop|restart"
+    RETVAL=1
+    ;;
+esac
+
+exit $RETVAL

+ 648 - 0
install.sh

@@ -0,0 +1,648 @@
+#!/bin/bash
+
+#
+# OGP - Open Game Panel
+# Copyright (C) Copyright (C) 2008 - 2013 The OGP Development Team
+#
+# http://www.opengamepanel.org/
+#
+# 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 2
+# of the License, or 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+#
+
+# Parameters can be passed into the install.sh script to automate OGP updates
+# $1 = Operation Type (Used as opType)
+# $2 = OGP User (Used as ogpAgentUser)
+# $3 = OGP User Sudo Pass (Used as ogpUserPass)
+# $4 = Install Path (Used as ogpInsPath)
+
+readonly DEFAULT_PORT=12679
+readonly DEFAULT_IP=0.0.0.0
+readonly AGENT_VERSION='v1.0'
+
+failed()
+{
+    echo "ERROR: ${1}"
+    exit 1
+}
+
+# Parameter notifications
+if [ ! -z "$1" ]; then
+	echo -n "Received operation type of $1 as a parameter."
+	opType="$1"
+fi
+
+if [ ! -z "$2" ]; then
+	echo -n "Received OGP user of $2 as a parameter."
+	ogpAgentUser="$2"
+fi 
+
+if [ ! -z "$3" ]; then
+	echo -n "Received OGP sudo password of $3 as a parameter."
+	ogpUserPass="$3"
+fi 
+
+if [ ! -z "$4" ]; then
+	echo -n "Received OGP agent path of $4 as a parameter."
+	ogpInsPath="$4"
+fi 
+
+if [ "X`which screen &> /dev/null;echo $?`" != "X0" ]; then
+    failed "You need to install software called 'screen', before you can install OGP agent.";
+fi
+
+if [ "X`which sed &> /dev/null;echo $?`" != "X0" ]; then
+    failed "You need to install software called 'sed', before you can install OGP agent.";
+fi
+echo
+clear
+echo "#######################################################################"
+echo "# OGP Agent installation and configuration"
+echo "# This program will:"
+echo "# Create ${DEFAULT_AGENT_HOME} or user defined directory"
+echo "# Copy ogp_agent files to ${DEFAULT_AGENT_HOME} or user defined dir"
+echo "# Copy the ogp_agent init script to /etc/init.d or user defined dir"
+echo "# Create an initial configuration file"
+echo "# Thank you for using OGP. http://www.opengamepanel.org/"
+echo "#######################################################################"
+echo 
+
+
+if [ "X`which rsync &> /dev/null;echo $?`" != "X0" ]; then
+    echo "*** WARNING **** missing rsync client. It is not required, but needed to use the rsync game installer";
+fi
+
+if [ "X`whoami`" != "Xroot" ]
+then 
+    echo
+    echo "Detected non-root install..."
+    username=`whoami`
+	echo -n "Enter sudo password: ";
+    read sudo_password;
+else
+    echo "Next you need to type the username of the user that owns the agent homes.";
+    echo "This user must own (have access to) all the game home directories that you"
+    echo "want to run with this agent and must to be in sudoers list so it can perform"
+	echo "administrative tasks.";echo
+    while [ 1 ]
+    do
+		if [ ! -z "$ogpAgentUser" ] ; then
+			username="$ogpAgentUser"
+		else
+			echo -n "Enter user name: ";
+			read username;
+        fi
+		
+		if [ -z "$ogpUserPass" ] ; then
+			echo -n "Enter user password: ";
+			read sudo_password;
+		else
+			sudo_password="$ogpUserPass"
+		fi
+
+        if [ -z "${username}" ]
+        then
+            echo "Username can not be empty.";echo
+            continue;
+        fi
+
+        if [ "Xroot" == "X${username}" ]
+        then
+            echo "'${username}' can not be used as user for agent.";echo
+            continue;
+        fi
+
+        ID_OF_USER=`id -u ${username} 2> /dev/null`
+        if [ $? != 0 ]
+        then
+            echo "User with entered username (${username}) does not exist.";echo
+            continue;
+        fi
+
+        break;
+    done
+fi
+
+readonly AGENT_USER_HOME="`cat /etc/passwd | grep "^${username}:" | cut -d':' -f6`/OGP/"
+
+echo
+echo "Next the directory for the agent needs to be chosen. The default directory";
+echo "Should be fine in most of the cases."
+echo
+
+if [ -z "$ogpInsPath" ]; then
+	echo "Where do you want to install the agent?"
+	echo -n "[Default is ${AGENT_USER_HOME}]: "
+	read agent_home
+else
+	agent_home="$ogpInsPath"
+fi
+
+if [ -z "${agent_home}" ]  
+then 
+    agent_home=$AGENT_USER_HOME
+fi
+
+# Try to prevent users from doing damage to their systems.
+case ${agent_home} in
+    /bin*|/boot*|/dev*|/etc*|/lib*|/proc*|/root*|/sbin*|/sys*|/)
+        failed "The agent home can not be ${agent_home}";
+        ;;
+esac
+
+echo "Agent install dir is ${agent_home}"
+echo
+agent_home=${agent_home%/}
+
+if [ ! -e ${agent_home} ]
+then 
+    mkdir -p ${agent_home} || failed "Failed to create the directory (${agent_home}) for agent."
+elif [ ! -w ${agent_home} ]
+then
+    failed "You do not have write permissions to the directory you assigned as agent home (${agent_home})."
+fi
+
+if [ "X`whoami`" == "Xroot" ];
+then
+    readonly DEFAULT_INIT_DIR="/etc/init.d/"
+else
+    readonly DEFAULT_INIT_DIR="${agent_home}/"
+fi
+
+if [ "X`uname`" != "XLinux" ]
+then 
+    echo
+    echo "Detected non-Linux platform..."
+    echo "Where do you want to put the init scripts?"
+	echo -n "[Default ${DEFAULT_INIT_DIR}]: "
+    read init_dir
+fi
+
+if [ -z "$opType" ]; then
+	echo "Where do you want to put the init scripts?"
+	echo -n "[Default ${DEFAULT_INIT_DIR}]:"
+	read init_dir
+fi
+
+if [ -z "${init_dir}" ]  
+then 
+    init_dir=${DEFAULT_INIT_DIR}
+fi
+init_dir=${init_dir%/}
+echo "Copying files..."
+
+cp -avf Crypt EHCP File Frontier IspConfig KKrcon ogp_agent.pl ogp_screenrc ogp_agent_run ${agent_home}/ || failed "Failed to copy agent files to ${agent_home}."
+
+# Create the directory for configs.
+mkdir -p ${agent_home}/Cfg || failed "Failed to create ${agent_home}/Cfg dir."
+echo
+
+if [ -e /etc/gentoo-release ] 
+then
+    echo "Copying ogp_agent.init.gentoo to $init_dir - Gentoo Specific Init"
+    init_file_template='includes/ogp_agent.init.gentoo' 
+elif [ -e /etc/sysconfig ] && [ ! -e /etc/debian_version ]
+then
+    echo "Copying ogp_agent.init.rh to $init_dir - Redhat Style Init (also SuSE, and Mandrake)"
+    init_file_template='includes/ogp_agent.init.rh' 
+elif [ -e /etc/debian_version ]
+then
+    echo "Copying ogp_agent.init.dbn to $init_dir - Debian Style Init"
+    init_file_template='includes/ogp_agent.init.dbn'
+else
+    echo "Copying the generic init script because I don't know what kind of Linux distro this is"
+    init_file_template='includes/ogp_agent.init'
+fi
+
+init_file=${init_dir}/ogp_agent
+
+cp -f $init_file_template $init_file || failed "Failed to create init file ($init_file)."
+# Next we replace the OGP_AGENT_DIR with the actual dir in init file.
+sed -i "s|OGP_AGENT_DIR|${agent_home}|" ${init_file} || failed "Failed to modify init file ($init_file)."
+sed -i "s|OGP_USER|${username}|" ${init_file} || failed "Failed to modify init file ($init_file)."
+
+chmod a+x $init_file
+echo;
+echo "Install Successful!"
+echo "Now configuring..."
+echo ""
+
+cfgfile=${agent_home}/Cfg/Config.pm
+prefsfile=${agent_home}/Cfg/Preferences.pm
+bashprefsfile=${agent_home}/Cfg/bash_prefs.cfg
+
+overwrite_config=1
+
+if [ -z "$opType" ]; then
+
+	if [ -e ${cfgfile} ]; then
+		while [ 1 ]
+		do
+			echo "Overwrite old config file ($cfgfile)?"
+			echo -n "(yes/no) [Default yes]: " 
+			read octmp
+			if [ "$octmp" == "yes" -o -z "$octmp" ]
+			then
+				break
+			elif [ "$octmp" == "no" ]
+			then
+				overwrite_config=0
+				break
+			else
+				echo "You need to type 'yes', 'no' or leave empty for default value [yes].";
+			fi
+		done
+	fi
+
+else
+	overwrite_config=0
+fi
+
+if [ "X${overwrite_config}" == "X1" ]
+then
+    echo "#######################################################################"
+    echo ""
+    echo "OGP agent uses basic encryption to prevent unauthorized users from connecting"
+    echo "Enter a string of alpha-numeric characters for example 'abcd12345'"
+    echo "**** NOTE - Use the same key in your Open Game Panel webpage config file - they must match *****"
+    echo ""
+
+    while [ -z "${key}" ]
+    do 
+        echo -n "Set encryption key: "
+        read key
+    done
+
+    echo
+    echo "Set the listen port for the agent. The default should be fine for everyone."
+    echo "However, if you want to change it that can be done here, otherwise just press Enter."
+    echo -n "Set listen port [Default ${DEFAULT_PORT}]: "
+    read port
+
+    if [ -z "${port}" ]
+    then 
+        port=$DEFAULT_PORT
+    fi
+
+    echo 
+    echo "Set the listen IP for the agent."
+    echo "Use ${DEFAULT_IP} to bind on all interfaces."
+    echo -n "Set listen IP [Default ${DEFAULT_IP}]: "
+    read ip
+
+    if [ -z "${ip}" ]  
+    then 
+        ip=$DEFAULT_IP
+    fi 
+
+    while [ 1 ]
+    do
+        echo
+        echo "For some games the OGP panel is using Steam client."
+        echo "This client has its own license that you need to agree before continuing."
+        echo "This agreement is available at http://store.steampowered.com/subscriber_agreement/"
+        echo;
+		echo "Do you accept the terms of Steam(tm) Subscriber Agreement?"
+		echo -n "(Accept|Reject): "
+        read steam_license
+        if [ "$steam_license" == "Accept" -o "$steam_license" == "Reject" ]
+        then 
+            break;
+        fi
+
+        echo "You need to type either 'Accept' or 'Reject'.";
+    done
+    
+    echo "Writing Config file - $cfgfile"
+
+    echo "%Cfg::Config = (
+    logfile => '${agent_home}/ogp_agent.log',
+    listen_port  => '${port}',
+    listen_ip => '${ip}',
+    version => '${AGENT_VERSION}',
+    key => '${key}',
+    steam_license => '${steam_license}',
+    sudo_password => '${sudo_password}',
+    );" > $cfgfile
+	
+	if [ $? != 0 ]
+    then
+        failed "Failed to write config file."
+    fi 
+    
+    echo;
+	while [ 1 ]
+    do
+		echo "The agent should be updated when the service is restarted or started?"
+		echo -n "(yes|no) [Default yes]: "
+		read auto_update
+		if [ "${auto_update}" == "yes" -o "${auto_update}" == "no" -o -z "${auto_update}" ]
+		then 
+			if [ "${auto_update}" == "yes" ]
+			then
+				autoUpdate=1
+			elif [ -z "${auto_update}" ]
+			then
+				autoUpdate=1
+			else
+				autoUpdate=0
+			fi
+			break;
+		fi
+        echo "You need to type 'yes', 'no' or leave empty for default value [yes].";
+    done
+	
+    echo;
+	while [ 1 ]
+    do
+		echo "The agent should backup the server log files in the game server directory?"
+		echo -n "(yes|no) [Default yes]: "
+		read log_local_copy
+		if [ "${log_local_copy}" == "yes" -o "${log_local_copy}" == "no" -o -z "${log_local_copy}" ]
+		then 
+			if [ "${log_local_copy}" == "yes" ]
+			then
+				logLocalCopy=1
+			elif [ -z "${log_local_copy}" ]
+			then
+				logLocalCopy=1
+			else
+				logLocalCopy=0
+			fi
+			break;
+		fi
+		echo "You need to type 'yes', 'no' or leave empty for default value [yes].";
+    done
+	
+	echo;	
+    echo "After how many days should be deleted the old backups of server's logs?"
+	echo -n "[Default 30]: "
+    read delete_logs_after
+    case ${delete_logs_after} in
+    	''|*[!0-9]*) deleteLogsAfter=30 ;;
+    	*) deleteLogsAfter=${delete_logs_after} ;;
+    esac
+    
+    echo;
+	while [ 1 ]
+    do
+		echo "The agent should automatically restart game servers if they crash?"
+		echo -n "(yes|no) [Default yes]: "
+		read auto_restart
+		if [ "${auto_restart}" == "yes" -o "${auto_restart}" == "no" -o -z "${auto_restart}" ]
+		then 
+			if [ "${auto_restart}" == "yes" ]
+			then
+				autoRestart=1
+			elif [ -z "${auto_restart}" ]
+			then
+				autoRestart=1
+			else
+				autoRestart=0
+			fi
+			break;
+		fi
+		echo "You need to type 'yes', 'no' or leave empty for default value [yes].";
+    done
+	
+	echo;
+	echo "What mirror you want to use for updating the agent?: "
+	echo;
+	echo "1  - SourceForge, Inc. (Chicago, Illinois, US)"
+	echo "2  - AARNet (Melbourne, Australia, AU)"
+	echo "3  - CityLan (Moscow, Russian Federation, RU)"
+	echo "4  - Free France (Paris, France, FR)"
+	echo "5  - garr.it (Ancona, Italy, IT)"
+	echo "6  - HEAnet (Ireland, IE)"
+	echo "7  - HiVelocity (Tampa, FL, US)"
+	echo "8  - Internode (Adelaide, Australia, AU)"
+	echo "9  - Japan Advanced Institute of Science and Technology (Nomi, Japan, JP)"
+	echo "10 - kaz.kz (Almaty, Kazakhstan, KZ)"
+	echo "11 - University of Kent (Canterbury, United Kingdom, GB)"
+	echo "12 - NetCologne (K&ouml;ln, Germany, DE)"
+	echo "13 - Optimate-Server (Germany, DE)"
+	echo "14 - Softlayer (Dallas, TX, US)"
+	echo "15 - SURFnet (Zurich, Switzerland, CH)"
+	echo "16 - SWITCH (Zurich, Switzerland, CH)"
+	echo "17 - Centro de Computacao Cientifica e Software Livre (Curitiba, Brazil, BR)"
+	read setmirror
+	case ${setmirror} in
+		1) mirror="master"
+		;;
+		2) mirror="aarnet"
+		;;
+		3) mirror="citylan"
+		;;
+		4) mirror="freefr"
+		;;
+		5) mirror="garr"
+		;;
+		6) mirror="heanet"
+		;;
+		7) mirror="hivelocity"
+		;;
+		8) mirror="internode"
+		;;
+		9) mirror="jaist"
+		;;
+		10) mirror="kaz"
+		;;
+		11) mirror="kent"
+		;;
+		12) mirror="netcologne"
+		;;
+		13) mirror="optimate"
+		;;
+		14) mirror="softlayer-dal"
+		;;
+		15) mirror="surfnet"
+		;;
+		16) mirror="switch"
+		;;
+		17) mirror="ufpr"
+		;;
+		*) mirror="master"
+		;;
+	esac
+	
+    echo;
+	while [ 1 ]
+    do
+		echo "Should Open Game Panel create and manage FTP accounts?"
+		echo -n "(yes|no) [Default yes]: "
+		read manage_ftp
+		if [ "${manage_ftp}" == "yes" -o "${manage_ftp}" == "no" -o -z "${manage_ftp}" ]
+		then
+			if [ "${manage_ftp}" == "yes" ]
+			then
+				ogpManagesFTP=1
+			elif [ -z "${manage_ftp}" ]
+			then
+				ogpManagesFTP=1
+			else
+				ogpManagesFTP=0
+			fi
+			break;
+		fi
+		echo "You need to type 'yes', 'no' or leave empty for default value [yes].";
+    done
+	
+    echo;
+    # Only ask these install questions if users want OGP to manage FTP accounts    
+    if [ "$ogpManagesFTP" == "1" ]
+	then
+		while [ 1 ]
+		do
+			echo "If you are running ISPConfig 3 in this machine the agent"
+			echo "can use it to create FTP accounts instead of using Pure-FTPd."
+			echo "Would you like to configure this agent to use the API of ISPConfig 3?"
+			echo -n "(yes|no) [Default no]: "
+			read IspConfig
+			if [ "${IspConfig}" == "yes" -o "${IspConfig}" == "no" -o -z "${IspConfig}" ]
+			then
+				if [ "${IspConfig}" == "yes" ]
+				then
+					ftpMethod="IspConfig"
+				else
+					IspConfig="no"
+				fi
+				break;
+			fi
+			echo "You need to type 'yes', 'no' or leave empty for default value [no].";
+		done
+		
+		if [ "${IspConfig}" == "yes" ]
+		then
+			while [ 1 ]
+			do
+				echo "Do you use HTTPS to access to your ISPConfig 3 Panel?"
+				echo -n "(yes|no) [Default no]: "
+				read https
+				if [ "${https}" == "yes" -o "${https}" == "no" -o -z "${https}" ]
+				then
+					if [ "${https}" == "yes" ]
+					then
+						secure="s"
+					else
+						secure=""
+					fi
+					break;
+				fi
+				echo "You need to type 'yes', 'no' or leave empty for default value [no].";
+			done
+			
+			echo -n "What port do you use to connect to your ISPConfig 3 Panel? [Default 8080]: "
+			read setport
+			case ${setport} in
+				''|*[!0-9]*) port=8080 ;;
+				*) port=${setport} ;;
+			esac
+			
+			echo -n "Enter an user name to sing in remotelly (Remote user): "
+			read remote_login_username
+
+			echo -n "Enter password (Remote user): "
+			read remote_login_password
+			
+			echo -e "<?php\n\$username = '${remote_login_username}';" > ${agent_home}/IspConfig/soap_config.php
+			echo "\$password = '${remote_login_password}';" >> ${agent_home}/IspConfig/soap_config.php
+			echo "\$soap_location = 'http${secure}://127.0.0.1:${port}/remote/index.php';" >> ${agent_home}/IspConfig/soap_config.php
+			echo -e "\$soap_uri = 'http${secure}://127.0.0.1:${port}/remote/';\n?>" >> ${agent_home}/IspConfig/soap_config.php
+			
+		else
+		
+			while [ 1 ]
+			do
+				echo;
+				echo "If you have installed the Easy Hosting Control Panel (EHCP - www.ehcp.net),"
+				echo "the agent can use it to create FTP accounts instead of using Pure-FTPd."
+				echo "Would you like to configure this agent to use the API of EHCP?"
+				echo -n "(yes|no) [Default no]: "
+				read ehcp
+				if [ "${ehcp}" == "yes" -o "${ehcp}" == "no" -o -z "${ehcp}" ]
+				then 
+					if [ "${ehcp}" == "yes" ]
+					then
+						ftpMethod="EHCP"
+					fi
+					break;
+				fi
+				echo "You need to type 'yes', 'no' or leave empty for default value [no].";
+			done
+			
+			if [ "${ehcp}" == "yes" ]
+			then
+				echo "Please enter the MySQL database password for the ehcp user"
+				echo -n "(created during the install of EHCP): "
+				read ehcpDB
+					
+				ehcpConf=${agent_home}/EHCP/config.php
+				sed -i "s/changeme/${ehcpDB}/" $ehcpConf
+			else
+				ftpMethod="PureFTPd"
+			fi
+		fi
+   	else
+		ftpMethod=""
+	fi
+	
+	clear
+	echo "Writing Preferences file - $prefsfile"
+	
+    echo "%Cfg::Preferences = (
+    screen_log_local => '${logLocalCopy}',
+    delete_logs_after => '${deleteLogsAfter}',
+    ogp_manages_ftp => '${ogpManagesFTP}',
+    ftp_method => '${ftpMethod}',
+    ogp_autorestart_server => '${autoRestart}',
+    );" > $prefsfile 
+	
+	if [ $? != 0 ]
+    then
+        failed "Failed to write preferences file."
+    fi
+    
+    echo "Writing bash script preferences file - $bashprefsfile"
+	
+    echo "agent_auto_update=${autoUpdate}\nsf_update_mirror=${mirror}" > $bashprefsfile
+	
+	if [ $? != 0 ]
+    then
+        failed "Failed to write MISC configuration file used by bash scripts."
+    fi
+fi
+
+echo "Setting Permissions on files in ${agent_home}..."
+chmod 750 ${init_dir}/ogp_agent || failed "Failed to chmod ${init_dir}/ogp_agent to 750."
+chmod 750 ${agent_home}/ogp_agent.pl || failed "Failed to chmod ${agent_home}/ogp_agent.pl to 750."
+chmod 600 ${cfgfile} || failed "Failed to chmod ${cfgfile} to 600."
+chmod 750 ${agent_home}/ogp_agent_run || failed "Failed to chmod ${agent_home}/ogp_agent_run to 750."
+
+echo "Chmodding files to user ${username}...";
+# Group of the files in agent_home can differ from the user so 
+# lets leave them as they are. So no chown user:group here.
+chown --preserve-root -R ${username} ${agent_home} || failed "Failed to chmod the agent_home ${agent_home} for user ${username}."
+
+echo;echo 
+echo "Installation complete!"  
+echo "Start the agent manually to test it like this:"
+echo "  cd ${agent_home}"
+echo "  ./ogp_agent.pl"
+echo
+echo "If everything looks good, hit <Ctrl C> to kill the agent." 
+echo "The agent can be started with the init scripst by using following command"
+echo "  ${init_dir}/ogp_agent start";
+echo 
+exit 0
+

+ 2660 - 0
ogp_agent.pl

@@ -0,0 +1,2660 @@
+#!/usr/bin/perl
+#
+# OGP - Open Game Panel
+# Copyright (C) Copyright (C) 2008 - 2013 The OGP Development Team
+#
+# http://www.opengamepanel.org/
+#
+# 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 2
+# of the License, or 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+#
+
+use warnings;
+use strict;
+
+use Frontier::Daemon::Forking;	# Forking XML-RPC server
+use File::Copy;				   # Simple file copy functions
+use File::Copy::Recursive
+  qw(fcopy rcopy dircopy fmove rmove dirmove pathempty pathrmdir)
+  ;							   # Used to copy whole directories
+use Crypt::XXTEA;	# Encryption between webpages and agent.
+use Cfg::Config;	 # Config file
+use Cfg::Preferences;   # Preferences file
+use Fcntl ':flock';  # Import LOCK_* constants for file locking
+use Cwd;			 # Fast way to get the current directory
+use LWP::Simple;	 # Used for fetching URLs
+use MIME::Base64;	# Used to ensure data travelling right through the network.
+use Getopt::Long;	# Used for command line params.
+use Path::Class::File;	# Used to handle files and directories.
+use File::Path qw(mkpath);
+use Archive::Extract;	 # Used to handle archived files.
+use File::Find;
+
+# Current location of the agent.
+use constant AGENT_RUN_DIR => getcwd();
+
+# Load our config file values
+use constant AGENT_KEY	  => $Cfg::Config{key};
+use constant AGENT_IP	   => $Cfg::Config{listen_ip};
+use constant AGENT_LOG_FILE => $Cfg::Config{logfile};
+use constant AGENT_PORT	 => $Cfg::Config{listen_port};
+use constant AGENT_VERSION  => $Cfg::Config{version};
+use constant SUDOPASSWD => $Cfg::Config{sudo_password};
+use constant SCREEN_LOG_LOCAL  => $Cfg::Preferences{screen_log_local};
+use constant DELETE_LOGS_AFTER  => $Cfg::Preferences{delete_logs_after};
+use constant AGENT_PID_FILE =>
+  Path::Class::File->new(AGENT_RUN_DIR, 'ogp_agent.pid');
+use constant GAME_AGENT_STARTUP_PID => 'ogp_game_agent_startup.pid';
+use constant STEAM_LICENSE_OK => "Accept";
+use constant STEAM_LICENSE	=> $Cfg::Config{steam_license};
+use constant MANUAL_TMP_DIR   => Path::Class::Dir->new(AGENT_RUN_DIR, 'tmp');
+use constant STEAM_CLIENT_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'steamc');
+use constant STEAM_CLIENT_BIN =>
+  Path::Class::File->new(STEAM_CLIENT_DIR, 'steam');
+use constant STEAMCMD_CLIENT_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'steamcmd');
+use constant STEAMCMD_CLIENT_BIN =>
+  Path::Class::File->new(STEAMCMD_CLIENT_DIR, 'steamcmd.sh');
+use constant STEAMCMD_LINUX32_DIR => Path::Class::Dir->new(STEAMCMD_CLIENT_DIR, 'linux32');
+use constant STEAMCMD_CLIENT_BIN_UPDATED =>
+  Path::Class::File->new(STEAMCMD_LINUX32_DIR, 'steamclient.so');
+use constant SCREEN_LOGS_DIR =>
+  Path::Class::Dir->new(AGENT_RUN_DIR, 'screenlogs');
+use constant GAME_STARTUP_DIR =>
+  Path::Class::Dir->new(AGENT_RUN_DIR, 'startups');
+use constant SCREENRC_FILE =>
+  Path::Class::File->new(AGENT_RUN_DIR, 'ogp_screenrc');
+use constant SCREENRC_TMP_FILE =>
+  Path::Class::File->new(AGENT_RUN_DIR, 'ogp_screenrc.tmp');
+use constant SCREEN_TYPE_HOME   => "HOME";
+use constant SCREEN_TYPE_UPDATE => "UPDATE";
+
+my $no_startups	= 0;
+my $clear_startups = 0;
+our $log_std_out = 0;
+
+GetOptions(
+		   'no-startups'	=> \$no_startups,
+		   'clear-startups' => \$clear_startups,
+		   'log-stdout'	 => \$log_std_out
+		  );
+
+# Starting the agent as root user is not supported anymore.
+if ($< == 0)
+{
+	print "ERROR: You are trying to start the agent as root user.";
+	print "This is not currently supported. If you wish to start the";
+	print "you need to create a normal user account for it.";
+	exit 1;
+}
+
+### Logger function.
+### @param line the line that is put to the log file.
+sub logger
+{
+	my $logcmd	 = $_[0];
+	my $also_print = 0;
+
+	if (@_ == 2)
+	{
+		($also_print) = $_[1];
+	}
+
+	$logcmd = localtime() . " $logcmd\n";
+
+	if ($log_std_out == 1)
+	{
+		print "$logcmd";
+		return;
+	}
+	if ($also_print == 1)
+	{
+		print "$logcmd";
+	}
+
+	open(LOGFILE, '>>', AGENT_LOG_FILE)
+	  or die("Can't open " . AGENT_LOG_FILE . " - $!");
+	flock(LOGFILE, LOCK_EX) or die("Failed to lock log file.");
+	seek(LOGFILE, 0, 2) or die("Failed to seek to end of file.");
+	print LOGFILE "$logcmd" or die("Failed to write to log file.");
+	flock(LOGFILE, LOCK_UN) or die("Failed to unlock log file.");
+	close(LOGFILE) or die("Failed to close log file.");
+}
+
+# Check the screen logs folder
+if (!-d SCREEN_LOGS_DIR && !mkdir SCREEN_LOGS_DIR)
+{
+	logger "Could not create " . SCREEN_LOGS_DIR . " directory $!.", 1;
+	exit -1;
+}
+
+# Rotate the log file
+if (-e AGENT_LOG_FILE)
+{
+	if (-e AGENT_LOG_FILE . ".bak")
+	{
+		unlink(AGENT_LOG_FILE . ".bak");
+	}
+	logger "Rotating log file";
+	move(AGENT_LOG_FILE, AGENT_LOG_FILE . ".bak");
+	logger "New log file created";
+}
+
+open INPUTFILE, "<", SCREENRC_FILE or die $!;
+open OUTPUTFILE, ">", SCREENRC_TMP_FILE or die $!;
+my $dest = SCREEN_LOGS_DIR . "/screenlog.%t";
+while (<INPUTFILE>) 
+{
+	$_ =~ s/logfile.*/logfile $dest/g;
+	print OUTPUTFILE $_;
+}
+close INPUTFILE;
+close OUTPUTFILE;
+unlink SCREENRC_FILE;
+move(SCREENRC_TMP_FILE,SCREENRC_FILE);
+
+sub backup_home_log
+{
+	my ($home_id, $log_file) = @_;
+	
+	my $home_backup_dir = SCREEN_LOGS_DIR . "/home_id_" . $home_id;
+		
+	if( ! -e $home_backup_dir )
+	{
+		if( ! mkdir $home_backup_dir )
+		{
+			logger "Can not create a backup directory at $home_backup_dir.";
+			return 1;
+		}
+	}
+	
+	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+	
+	my $backup_file_name =  $mday . $mon . $year . '_' . $hour . 'h' . $min . 'm' . $sec . "s.log";
+	
+	my $output_path = $home_backup_dir . "/" . $backup_file_name;
+	
+	# Used for deleting log files older than DELETE_LOGS_AFTER
+	my @file_list;
+	my @find_dirs; # directories to search
+	my $now = time(); # get current time
+	my $days;
+	if((DELETE_LOGS_AFTER =~ /^[+-]?\d+$/) && (DELETE_LOGS_AFTER > 0)){
+		$days = DELETE_LOGS_AFTER; # how many days old
+	}else{
+		$days = 30; # how many days old
+	}
+	my $seconds_per_day = 60*60*24; # seconds in a day
+	my $AGE = $days*$seconds_per_day; # age in seconds
+	push (@find_dirs, $home_backup_dir);
+	
+	# Create local copy of log file backup in the log_backups folder and current user home directory if SCREEN_LOG_LOCAL = 1 
+	if(SCREEN_LOG_LOCAL == 1)
+	{
+		# Create local backups folder
+		my $local_log_folder = Path::Class::Dir->new("logs_backup");
+		
+		if(!-e $local_log_folder){
+			mkdir($local_log_folder);
+		}
+		
+		# Add full path to @find_dirs so that log files older than DELETE_LOGS_AFTER are deleted
+		my $fullpath_to_local_logs = Path::Class::Dir->new(getcwd(), "logs_backup");
+		push (@find_dirs, $fullpath_to_local_logs);
+		
+		my $log_local = $local_log_folder . "/" . $backup_file_name;
+		
+		# Delete the local log file if it already exists
+		if(-e $log_local){
+			unlink $log_local;
+		}
+		
+		# If the log file contains UPDATE in the filename, do not allow users to see it since it will contain steam credentials
+		# Will return -1 for not existing
+		my $isUpdate = index($log_file,SCREEN_TYPE_UPDATE);
+		
+		if($isUpdate == -1){
+			copy($log_file,$log_local);
+		}
+	}
+	
+	# Delete all files in @find_dirs older than DELETE_LOGS_AFTER days
+	find ( sub {
+		my $file = $File::Find::name;
+		if ( -f $file ) {
+			push (@file_list, $file);
+		}
+	}, @find_dirs);
+ 
+	for my $file (@file_list) {
+		my @stats = stat($file);
+		if ($now-$stats[9] > $AGE) {
+			unlink $file;
+		}
+	}
+	
+	move($log_file,$output_path);
+	
+	return 0;
+}
+
+sub get_home_pids
+{
+	my ($home_dir) = @_;
+	my @pids;
+	my $opendir_retval = opendir HOME_DIR, $home_dir;
+
+	if (!$opendir_retval)
+	{
+		logger "Failed to open directory: $home_dir";
+		return @pids;
+	}
+
+	my $running = `ps -A`;
+
+	while (my $filename = readdir(HOME_DIR))
+	{
+		next if ($filename !~ /\.pid$/);
+
+		my $full_file_path = Path::Class::File->new($home_dir, $filename);
+		open(FILE, '<', $full_file_path);
+
+		while (<FILE>)
+		{
+
+			# Some pid files might have trailing space, linefeed or character return
+			# so we need to remove those.
+			chomp;
+			next if ($running !~ /\s*$_\s/);
+			push(@pids, $_);
+		}
+		close FILE;
+	}
+	closedir HOME_DIR;
+	return @pids;
+}
+
+sub create_screen_id
+{
+	my ($screen_type, $home_id) = @_;
+	return sprintf("OGP_%s_%09d", $screen_type, $home_id);
+}
+
+sub create_screen_cmd
+{
+	my ($screen_id, $exec_cmd) = @_;
+	$exec_cmd = replace_OGP_Vars($screen_id, $exec_cmd);
+	return
+	  sprintf('export DISPLAY=:1 && screen -d -m -t "%1$s" -c ' . SCREENRC_FILE . ' -S %1$s %2$s',
+			  $screen_id, $exec_cmd);
+
+}
+
+sub create_screen_cmd_loop
+{
+	my ($screen_id, $exec_cmd) = @_;
+	my $server_start_bashfile = $screen_id . "_startup_scr.sh";
+	
+	$exec_cmd = replace_OGP_Vars($screen_id, $exec_cmd);
+	
+	# Allow file to be overwritten
+	if(-e $server_start_bashfile){
+		sudo_exec_without_decrypt('chattr -i '.$server_start_bashfile);
+	}
+	
+	# Create bash file that screen will run which spawns the server
+	# If it crashes without user intervention, it will restart
+	open (SERV_START_SCRIPT, '>', $server_start_bashfile);
+	my $respawn_server_command = "#!/bin/bash" . "\n" 
+	. "function startServer(){" . "\n" 
+	. "NUMSECONDS=`expr \$(date +%s)`" . "\n"
+	. "until " . $exec_cmd . "; do" . "\n" 
+	. "let DIFF=(`date +%s` - \"\$NUMSECONDS\")" . "\n"
+	. "if [ \"\$DIFF\" -gt 15 ]; then" . "\n" 
+	. "NUMSECONDS=`expr \$(date +%s)`" . "\n"
+	. "echo \"Server '" . $exec_cmd . "' crashed with exit code \$?.  Respawning...\" >&2 " . "\n" 
+	. "fi" . "\n" 
+	. "sleep 3" . "\n" 
+	. "done" . "\n" 
+	. "let DIFF=(`date +%s` - \"\$NUMSECONDS\")" . "\n"
+	
+	. "if [ ! -e \"SERVER_STOPPED\" ] && [ \"\$DIFF\" -gt 15 ]; then" . "\n"
+	. "startServer" . "\n"
+	. "fi" . "\n"
+	. "}" . "\n"
+	. "startServer" . "\n";
+	print SERV_START_SCRIPT $respawn_server_command;
+	close (SERV_START_SCRIPT);
+	
+	# Secure file
+	sudo_exec_without_decrypt('chattr +i '.$server_start_bashfile);
+	
+	my $screen_exec_script = "bash " . $server_start_bashfile;
+	
+	return
+	  sprintf('export DISPLAY=:1 && screen -d -m -t "%1$s" -c ' . SCREENRC_FILE . ' -S %1$s %2$s',
+			  $screen_id, $screen_exec_script);
+
+}
+
+sub replace_OGP_Vars{
+	# This function replaces constants from game server XML Configs with OGP paths for Steam Auto Updates for example
+	my ($screen_id, $exec_cmd) = @_;
+	my $screen_id_for_txt_update = substr ($screen_id, rindex($screen_id, '_') + 1);
+	my $steamInsFile = $screen_id_for_txt_update . "_install.txt";
+	my $steamCMDPath = STEAMCMD_CLIENT_DIR;
+	my $fullPath = Path::Class::File->new($steamCMDPath, $steamInsFile);
+	
+	# If the install file exists, the game can be auto updated, else it will be ignored by the game for improper syntax
+	# To generate the install file, the "Install/Update via Steam" button must be clicked on at least once!
+	if(-e $fullPath){
+		$exec_cmd =~ s/{OGP_STEAM_CMD_DIR}/$steamCMDPath/g;
+		$exec_cmd =~ s/{STEAMCMD_INSTALL_FILE}/$steamInsFile/g;
+	}
+	
+	return $exec_cmd;
+}
+
+sub is_screen_running_without_decrypt
+{
+	my ($screen_type, $home_id) = @_;
+
+	my $screen_id = create_screen_id($screen_type, $home_id);
+
+	my $is_running = `screen -list | grep $screen_id`;
+
+	if ($is_running =~ /^\s*$/)
+	{
+		logger "Home with id $screen_id is not running.";
+		return 0;
+	}
+	else
+	{
+		logger "Home with id $screen_id is running.";
+		return 1;
+	}
+}
+
+sub encode_list
+{
+	my $encoded_content = '';
+	foreach (@_)
+	{
+		$encoded_content .= encode_base64($_, '\n');
+	}
+	return $encoded_content;
+}
+
+sub decrypt_param
+{
+	my ($param) = @_;
+	$param = decode_base64($param);
+	$param = Crypt::XXTEA::decrypt($param, AGENT_KEY);
+	$param = decode_base64($param);
+	return $param;
+}
+
+sub decrypt_params
+{
+	my @params;
+	foreach my $param (@_)
+	{
+		$param = &decrypt_param($param);
+		push(@params, $param);
+	}
+	return @params;
+}
+
+sub check_steam_cmd_client
+{
+	if (STEAM_LICENSE ne STEAM_LICENSE_OK)
+	{
+		logger "Steam license not accepted, stopping steam client check.";
+		return 0;
+	}
+
+	while (is_screen_running_without_decrypt(SCREEN_TYPE_UPDATE, "0") == 1)
+	{
+		sleep 1;
+	}
+	
+	if (-f STEAMCMD_CLIENT_BIN_UPDATED)
+	{
+		logger "Steam client ok.";
+		return 1;
+	}
+	
+
+	if (!-d STEAMCMD_CLIENT_DIR && !mkdir STEAMCMD_CLIENT_DIR)
+	{
+		logger "Could not create " . STEAMCMD_CLIENT_DIR . " directory $!.", 1;
+		exit -1;
+	}
+	if (!-w STEAMCMD_CLIENT_DIR)
+	{
+		logger "Steam client dir '"
+		  . STEAMCMD_CLIENT_DIR
+		  . "' not writable. Unable to get steam client.";
+		return -1;
+	}
+
+	chdir STEAMCMD_CLIENT_DIR;
+
+	# These two commands needs to be variables changed depending the platform.
+	my $steam_client_file		  = 'steamcmd_linux.tar.gz';
+	my $steam_installation_command = 'tar -xzvf ' . $steam_client_file;
+
+	if (!-f Path::Class::File->new(STEAMCMD_CLIENT_DIR, $steam_client_file))
+	{
+		my $steam_client_url =
+		  "http://media.steampowered.com/client/" . $steam_client_file;
+		logger "Downloading the steam client from $steam_client_url to '"
+		  . getcwd() . "'.";
+		my $steam_client_val = getstore($steam_client_url, $steam_client_file);
+		if ($steam_client_val != 200)
+		{
+			logger "Failed to download steam binary from "
+			  . $steam_client_url
+			  . ". Error code: "
+			  . $steam_client_val
+			  . "", 1;
+			return -1;
+		}
+	}
+	
+	my $steam_installation = system($steam_installation_command);
+	if ($steam_installation == 0)
+	{
+		logger "Failed to execute '"
+		  . $steam_installation_command
+		  . "' in dir "
+		  . STEAMCMD_CLIENT_DIR . ".";
+		return -1;
+	}
+		
+	if (!-f STEAMCMD_CLIENT_BIN_UPDATED)
+	{
+		my $steam_update_command = 'bash ' . STEAMCMD_CLIENT_DIR . '/steamcmd.sh +exit';
+		my $home_path = STEAMCMD_CLIENT_DIR;
+		my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, "0");
+		my $screen_cmd = create_screen_cmd($screen_id, $steam_update_command);
+		my $steam_first_update = system($screen_cmd);
+		if ($steam_first_update == 0)
+		{
+			logger "Failed to execute '"
+			  . $steam_update_command
+			  . "' in dir "
+			  . STEAMCMD_CLIENT_DIR . ".";
+			return -1;
+		}
+		while (is_screen_running_without_decrypt(SCREEN_TYPE_UPDATE, "0") == 1)
+		{
+			if( -f STEAMCMD_CLIENT_BIN_UPDATED)
+			{
+				my $update_screen_id = create_screen_id(SCREEN_TYPE_HOME, "0");
+				system('screen -S '.$update_screen_id.' -X quit');
+				system('screen -wipe');
+			}
+			sleep 1;
+		}
+		my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+		backup_home_log( "0", $log_file );
+	}
+	unlink($steam_client_file);
+	
+	chdir AGENT_RUN_DIR;
+	
+	return 1;
+}
+
+logger "Open Game Panel - Agent started - "
+  . AGENT_VERSION
+  . " - port "
+  . AGENT_PORT
+  . " - PID $$", 1;
+
+# create the directory for startup flags
+if (!-e GAME_STARTUP_DIR)
+{
+	logger "Creating the startups directory " . GAME_STARTUP_DIR . "";
+	if (!mkdir GAME_STARTUP_DIR)
+	{
+		my $message =
+			"Failed to create the "
+		  . GAME_STARTUP_DIR
+		  . " directory - check permissions. Errno: $!";
+		logger $message, 1;
+		exit 1;
+	}
+}
+
+elsif ($clear_startups)
+{
+	opendir(STARTUPDIR, GAME_STARTUP_DIR);
+	while (my $startup_file = readdir(STARTUPDIR))
+	{
+
+		# Skip . and ..
+		next if $startup_file =~ /^\./;
+		$startup_file = Path::Class::File->new(GAME_STARTUP_DIR, $startup_file);
+		logger "Removing " . $startup_file . ".";
+		unlink($startup_file);
+	}
+	closedir(STARTUPDIR);
+}
+
+# If the directory already existed check if we need to start some games.
+elsif ($no_startups != 1)
+{
+
+	# Loop through all the startup flags, and call universal startup
+	opendir(STARTUPDIR, GAME_STARTUP_DIR);
+	logger "Reading startup flags from " . GAME_STARTUP_DIR . "";
+	while (my $dirlist = readdir(STARTUPDIR))
+	{
+
+		# Skip . and ..
+		next if $dirlist =~ /^\./;
+		logger "Found $dirlist";
+		open(STARTFILE, '<', Path::Class::Dir->new(GAME_STARTUP_DIR, $dirlist))
+		  || logger "Error opening start flag $!";
+		while (<STARTFILE>)
+		{
+			my (
+				$home_id,   $home_path,   $server_exe,
+				$run_dir,   $startup_cmd, $server_port,
+				$server_ip, $cpu,		 $nice
+			   ) = split(',', $_);
+
+			if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) ==
+				1)
+			{
+				logger
+				  "This server ($server_exe on $server_ip : $server_port) is already running (ID: $home_id).";
+				next;
+			}
+
+			logger "Starting server_exe $server_exe from home $home_path.";
+			universal_start_without_decrypt(
+										 $home_id,   $home_path,   $server_exe,
+										 $run_dir,   $startup_cmd, $server_port,
+										 $server_ip, $cpu,		 $nice
+										   );
+		}
+		close(STARTFILE);
+	}
+	closedir(STARTUPDIR);
+}
+
+# Create the pid file
+open(PID, '>', AGENT_PID_FILE)
+  or die("Can't write to pid file - " . AGENT_PID_FILE . "\n");
+print PID "$$\n";
+close(PID);
+
+my $d = Frontier::Daemon::Forking->new(
+			 methods => {
+				 is_screen_running				=> \&is_screen_running,
+				 universal_start			  	=> \&universal_start,
+				 renice_process					=> \&renice_process,
+				 cpu_count						=> \&cpu_count,
+				 rfile_exists				 	=> \&rfile_exists,
+				 quick_chk						=> \&quick_chk,
+				 steam							=> \&steam,
+				 steam_cmd						=> \&steam_cmd,
+				 get_log					  	=> \&get_log,
+				 stop_server				  	=> \&stop_server,
+				 send_rcon_command				=> \&send_rcon_command,
+				 dirlist						=> \&dirlist,
+				 dirlistfm						=> \&dirlistfm,
+				 readfile					 	=> \&readfile,
+				 writefile						=> \&writefile,
+				 what_os					  	=> \&what_os,
+				 start_file_download		  	=> \&start_file_download,
+				 is_file_download_in_progress 	=> \&is_file_download_in_progress,
+				 uncompress_file			  	=> \&uncompress_file,
+				 discover_ips					=> \&discover_ips,
+				 mon_stats						=> \&mon_stats,
+				 exec						 	=> \&exec,
+				 clone_home				   		=> \&clone_home,
+				 remove_home					=> \&remove_home,
+				 start_rsync_install			=> \&start_rsync_install,
+				 rsync_progress			   		=> \&rsync_progress,
+				 restart_server			   		=> \&restart_server,
+				 sudo_exec						=> \&sudo_exec,
+				 master_server_update			=> \&master_server_update,
+				 secure_path					=> \&secure_path,
+				 get_chattr						=> \&get_chattr,
+				 ftp_mgr						=> \&ftp_mgr,
+				 
+			 },
+			 debug	 => 4,
+			 LocalPort => AGENT_PORT,
+			 LocalAddr => AGENT_IP,
+			 ReuseAddr => '1'
+) or die "Couldn't start OGP Agent: $!";
+
+sub is_screen_running
+{
+	my ($screen_type, $home_id) = decrypt_params(@_);
+	return is_screen_running_without_decrypt($screen_type, $home_id);
+}
+
+# Delete Server Stopped Status File:
+
+sub deleteStoppedStatFile{
+	my $server_stop_status_file = "SERVER_STOPPED";
+		
+	if(-e $server_stop_status_file){
+		unlink $server_stop_status_file;
+	}
+}
+
+# Universal startup function
+sub universal_start
+{
+	chomp(@_);
+	return universal_start_without_decrypt(decrypt_params(@_));
+}
+
+# Split to two parts because of internal calls.
+sub universal_start_without_decrypt
+{
+	my (
+		$home_id,	 $home_path, $server_exe, $run_dir, $startup_cmd,
+		$server_port, $server_ip, $cpu,		$nice
+	   ) = @_;
+	   
+	if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) == 1)
+	{
+		logger "This server is already running (ID: $home_id).";
+		return -14;
+	}
+
+	if (!-e $home_path)
+	{
+		logger "Can't find server's install path [ $home_path ].";
+		return -10;
+	}
+
+	# Some game require that we are in the directory where the binary is.
+	my $game_binary_dir = Path::Class::Dir->new($home_path, $run_dir);
+	if (!chdir $game_binary_dir)
+	{
+		logger "Could not change to server binary directory $game_binary_dir.";
+		return -12;
+	}
+	
+	my $whoami = `whoami`;
+	chop $whoami;
+	my $group = `groups $whoami | awk '{ print \$3 }'`;
+	chop $group;
+	
+	my $chown_path = "chown -Rf $whoami:$group " . $home_path;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chown_path");
+	my $chown_exe = "chown -Rf 0:$group " . $server_exe;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chown_exe");
+	
+	if (!-x $server_exe)
+	{
+		my $chmod_exe = chmod 0755, $server_exe;
+		if (!$chmod_exe)
+		{
+			logger "The $server_exe file is not executable.";
+			return -13;
+		}
+	}
+	
+	# Create startup file for the server.
+	my $startup_file =
+	  Path::Class::File->new(GAME_STARTUP_DIR, "$server_ip-$server_port");
+	if (open(STARTUP, '>', $startup_file))
+	{
+		print STARTUP
+		  "$home_id,$home_path,$server_exe,$run_dir,$startup_cmd,$server_port,$server_ip,$cpu,$nice";
+		logger "Created startup flag for $server_ip-$server_port";
+		close(STARTUP);
+	}
+	else
+	{
+		logger "Cannot create file in " . $startup_file . " : $!";
+	}
+			
+	# Create the startup string.
+	my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
+	my $file_extension = substr $server_exe, -4;
+	my $cli_bin;
+	my $command;
+	
+	if($file_extension eq ".exe" or $file_extension eq ".bat")
+	{
+		$command = "wine $server_exe $startup_cmd";
+		
+		if ($cpu ne 'NA')
+		{
+			$command = "taskset -c $cpu wine $server_exe $startup_cmd";
+		}
+		
+		if(defined($Cfg::Preferences{ogp_autorestart_server}) &&  $Cfg::Preferences{ogp_autorestart_server} eq "1"){
+			deleteStoppedStatFile();
+			$cli_bin = create_screen_cmd_loop($screen_id, $command);
+		}else{
+			$cli_bin = create_screen_cmd($screen_id, $command);
+		}
+	}
+	elsif($file_extension eq ".jar")
+	{
+		$command = "$startup_cmd";
+		
+		if ($cpu ne 'NA')
+		{
+			$command = "taskset -c $cpu $startup_cmd";
+		}
+		
+		if(defined($Cfg::Preferences{ogp_autorestart_server}) &&  $Cfg::Preferences{ogp_autorestart_server} eq "1"){
+			deleteStoppedStatFile();
+			$cli_bin = create_screen_cmd_loop($screen_id, $command);
+		}else{
+			$cli_bin = create_screen_cmd($screen_id, $command);
+		}
+	}
+	else
+	{
+		$command = "./$server_exe $startup_cmd";
+		
+		if ($cpu ne 'NA')
+		{
+			$command = "taskset -c $cpu ./$server_exe $startup_cmd";
+		}
+		
+		if(defined($Cfg::Preferences{ogp_autorestart_server}) &&  $Cfg::Preferences{ogp_autorestart_server} eq "1"){
+			deleteStoppedStatFile();
+			$cli_bin = create_screen_cmd_loop($screen_id, $command);
+		}else{
+			$cli_bin = create_screen_cmd($screen_id, $command);
+		}
+	}
+		
+	my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+	backup_home_log( $home_id, $log_file );
+	
+	logger
+	  "Startup command [ $cli_bin ] will be executed in dir $game_binary_dir.";
+	
+	system($cli_bin);
+	
+	renice_process_without_decrypt($screen_id, $nice);
+		
+	chdir AGENT_RUN_DIR;
+	return 1;
+}
+
+# This is used to change the priority of process
+# @return 0 if successfully set prosess priority
+# @return 1 in case of an error.
+sub renice_process
+{
+	return renice_process_without_decrypt(decrypt_params(@_));
+}
+
+sub renice_process_without_decrypt
+{
+	my ($screen_id, $nice) = @_;
+	
+	my $return_value = 1;
+	
+	if ($nice != 0)
+	{		
+		my $get_screen_pid = 'ps x | grep '.$screen_id.' | grep SCREEN | awk "{ print \$1 }"';
+				
+		my @screen_pids = `$get_screen_pid`;
+			
+		chomp($screen_pids[0]);
+		
+		if($screen_pids[0] > 0)
+		{
+			my $get_child_pid = 'pgrep -P '.$screen_pids[0];
+			my $child_pid = `$get_child_pid`;
+			chomp($child_pid);
+
+			if($child_pid =~ /^[0-9]+$/)
+			{
+				my @pids;
+				push(@pids,$child_pid);
+				
+				while ($child_pid =~ /^[0-9]+$/)
+				{
+					$get_child_pid = 'pgrep -P '.$child_pid;
+					$child_pid = `$get_child_pid`;
+					chomp($child_pid);
+					if($child_pid =~ /^[0-9]+$/)
+					{
+						push(@pids,$child_pid);
+					}
+				}			
+						
+				logger
+				  "Renicing pids [ @pids ] with nice value $nice.";
+				
+				my $sudo_on = "echo \"".SUDOPASSWD."\" | sudo -p \"\" -S echo -n OK";
+				$return_value = `$sudo_on`;
+				
+				if($return_value eq "OK")
+				{
+					foreach my $pid (@pids)
+					{
+						my $rpid = kill 0, $pid;
+						if ($rpid == 1)
+						{
+							my $setrenice = "/usr/bin/renice $nice $pid";
+							system("sudo su -c '".$setrenice."' root");
+						}
+					}
+					system("sudo -k");
+				}
+				$return_value = $return_value eq "OK" ? 1 : -1;
+			}
+		}
+	}
+	return $return_value;
+}
+
+# This is used to force a process to run on a particular CPU
+sub force_cpu
+{
+	return force_cpu_without_decrypt(decrypt_params(@_));
+}
+
+sub force_cpu_without_decrypt
+{
+	my ($home_pid_dir, $cpu) = @_;
+	if ($cpu eq 'NA')
+	{
+		logger "Force CPU not used for home $home_pid_dir.";
+		return 1;
+	}
+	my @pids		 = get_home_pids($home_pid_dir);
+	my $return_value = 0;
+	logger
+	  "Setting server from home $home_pid_dir with pids @pids to run on CPU $cpu.";
+	foreach my $pid (@pids)
+	{
+		my $rpid = kill 0, $pid;
+		if ($rpid == 1)
+		{
+			# TODO: For some reason the system return -1 always?
+			my $setcpu = "/usr/bin/taskset -pc $cpu $pid";
+			system("echo \"".SUDOPASSWD."\" | sudo -S echo '\nsudo on'");
+			my $system_retval = system("sudo su -c '".$setcpu."' root");
+			system("sudo -k && echo 'sudo off'");
+			logger "Taskset returned with value $system_retval.";
+			$return_value = $system_retval == 0 ? $return_value : 1;
+		}
+	}
+	return $return_value;
+}
+
+# Returns the number of CPUs available.
+sub cpu_count
+{
+	if (!-e "/proc/cpuinfo")
+	{
+		return "ERROR - Missing /proc/cpuinfo";
+	}
+
+	open(CPUINFO, '<', "/proc/cpuinfo")
+	  or return "ERROR - Cannot open /proc/cpuinfo";
+
+	my $cpu_count = 0;
+
+	while (<CPUINFO>)
+	{
+		chomp;
+		next if $_ !~ /^processor/;
+		$cpu_count++;
+	}
+	close(CPUINFO);
+	return "$cpu_count";
+}
+
+### File exists check ####
+# Simple a way to check if a file exists using the remote agent
+#
+# @return 0 when file exists.
+# @return 1 when file does not exist.
+sub rfile_exists
+{
+	chdir AGENT_RUN_DIR;
+	my $checkFile = decrypt_param(@_);
+
+	if (-e $checkFile)
+	{
+		return 0;
+	}
+	else
+	{
+		return 1;
+	}
+}
+
+#### Quick check to verify agent is up and running
+# Used to quickly see if the agent is online, and if the keys match.
+# The message that is sent to the agent must be hello, if not then
+# it is intrepret as encryption key missmatch.
+#
+# @return 1 when encrypted message is not 'hello'
+# @return 0 when check is ok.
+sub quick_chk
+{
+	my $dec_check = &decrypt_param(@_);
+	if ($dec_check ne 'hello')
+	{
+		logger "ERROR - Encryption key mismatch! Returning 1 to asker.";
+		return 1;
+	}
+	return 0;
+}
+
+sub rcon_quit_postback_handler
+{
+	my ($type, $ip, $port, $command, $identifier, $response) = @_;
+	logger "Rcon command of $command to a $type server";
+	logger " at $ip:$port";
+	logger " had a identifier of $identifier" if defined $identifier;
+	logger " returned from the server with:\n$response\n";
+}
+
+### Return -10 If home path is not found.
+### Return -9  If log type was invalid.
+### Return -8  If log file was not found.
+### 0 reserved for connection problems.
+### Return 1;content If log found and screen running.
+### Return 2;content If log found but screen is not running.
+sub get_log
+{
+	my ($screen_type, $home_id, $home_path, $nb_of_lines) = decrypt_params(@_);
+
+	if (!chdir $home_path)
+	{
+		logger "Can't change to server's install path [ $home_path ].";
+		return -10;
+	}
+
+	if (   ($screen_type eq SCREEN_TYPE_UPDATE)
+		&& ($screen_type eq SCREEN_TYPE_HOME))
+	{
+		logger "Invalid screen type '$screen_type'.";
+		return -9;
+	}
+
+	my $screen_id = create_screen_id($screen_type, $home_id);
+		
+	my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+	
+	chmod 0644, $log_file;	
+	
+	# Create local copy of current log file if SCREEN_LOG_LOCAL = 1
+	if(SCREEN_LOG_LOCAL == 1)
+	{
+		my $log_local = Path::Class::File->new($home_path, "LOG_$screen_type.txt");
+		if ( -e $log_local )
+		{
+			unlink $log_local;
+		}
+		
+		# Copy log file only if it's not an UPDATE type as it may contain steam credentials
+		if($screen_type eq SCREEN_TYPE_HOME){
+			copy($log_file, $log_local);
+		}
+	}
+	
+	# Regenerate the log file if it doesn't exist
+	unless ( -e $log_file )
+	{
+		if (open(NEWLOG, '>', $log_file))
+		{
+			logger "Log file missing, regenerating: " . $log_file;
+			print NEWLOG "Log file missing, started new log\n";
+			close(NEWLOG);
+		}
+		else
+		{
+			logger "Cannot regenerate log file in " . $log_file . " : $!";
+			return -8;
+		}
+	}
+	
+	# Return a few lines of output to the web browser
+	my(@modedlines) = `tail -n $nb_of_lines $log_file`;
+	
+	my $linecount = 0;
+	
+	foreach my $line (@modedlines) {
+		#Text replacements to remove the Steam user login from steamcmd logs for security reasons.
+		$line =~ s/login .*//g;
+		$line =~ s/Logging .*//g;
+		$line =~ s/set_steam_guard_code.*//g;
+		$line =~ s/force_install_dir.*//g;
+		#Text replacements to remove empty lines.
+		$line =~ s/^ +//g;
+		$line =~ s/^\t+//g;
+		$line =~ s/^\e+//g;
+		#Remove � from console output when master server update is running.
+		$line =~ s/�//g;
+		$modedlines[$linecount]=$line;
+		$linecount++;
+	} 
+	
+	my $encoded_content = encode_list(@modedlines);
+	chdir AGENT_RUN_DIR;
+	if(is_screen_running_without_decrypt($screen_type, $home_id) == 1)
+	{
+		return "1;" . $encoded_content;
+	}
+	else
+	{
+		return "2;" . $encoded_content;
+	}
+}
+
+# stop server function
+sub stop_server
+{
+	chomp(@_);
+	my ($home_id, $server_ip, $server_port, $control_protocol,
+		$control_password, $control_type, $home_path) = decrypt_params(@_);
+		
+	my $startup_file =
+	Path::Class::File->new(GAME_STARTUP_DIR, "$server_ip-$server_port");
+	
+	if (-e $startup_file)
+	{
+		logger "Removing startup flag " . $startup_file . "";
+		unlink($startup_file)
+		  or logger "Cannot remove the startup flag file $startup_file $!";
+	}
+	
+	# Create file indicator that the game server has been stopped if defined
+	if(defined($Cfg::Preferences{ogp_autorestart_server}) &&  $Cfg::Preferences{ogp_autorestart_server} eq "1"){
+		
+		# Get current directory and chdir into the game's home dir
+		my $curDir = getcwd();
+		chdir $home_path;
+
+		# Create stopped indicator file used by autorestart of OGP if server crashes
+		open(STOPFILE, '>', "SERVER_STOPPED");
+		close(STOPFILE);
+		
+		# Return to original directory
+		chdir $curDir;
+	}
+	
+	
+	
+	return stop_server_without_decrypt($home_id, $server_ip,
+									   $server_port, $control_protocol,
+									   $control_password, $control_type);
+}
+##### Stop server without decrypt
+### Return 1 when error occurred on decryption.
+### Return 0 on success
+sub stop_server_without_decrypt
+{
+	my ($home_id, $server_ip, $server_port, $control_protocol,
+		$control_password, $control_type) = @_;
+	
+	# Some validation checks for the variables.
+	if ($server_ip =~ /^\s*$/ || $server_port < 0 || $server_port > 65535)
+	{
+		logger("Invalid IP:Port given $server_ip:$server_port.");
+		return 1;
+	}
+
+	if ($control_password !~ /^\s*$/ and $control_protocol ne "")
+	{
+		if ($control_protocol eq "rcon")
+		{
+			use KKrcon::KKrcon;
+			my $rcon = new KKrcon(
+								  Password => $control_password,
+								  Host	 => $server_ip,
+								  Port	 => $server_port,
+								  Type	 => $control_type
+								 );
+
+			my $rconCommand = "quit";
+			$rcon->execute($rconCommand);
+		}
+		elsif ($control_protocol eq "rcon2")
+		{
+			use KKrcon::HL2;
+			my $rcon2 = new HL2(
+								  hostname => $server_ip,
+								  port	 => $server_port,
+								  password => $control_password,
+								  timeout  => 2
+								 );
+
+			my $rconCommand = "quit";
+			$rcon2->run($rconCommand);
+		}
+		
+		if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) == 0)
+		{
+			logger "Stopped server $server_ip:$server_port with rcon quit.";
+			return 0;
+		}
+		else
+		{
+			logger "Failed to send rcon quit. Stopping server with kill command.";
+		}
+
+		my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
+		
+		my $get_screen_pid = 'ps x | grep '.$screen_id.' | grep SCREEN | awk "{ print \$1 }"';
+									
+		my @screen_pids = `$get_screen_pid`;
+			
+		chomp($screen_pids[0]);
+		
+		my @sh_pids;
+		my @server_pids;
+		
+		if($screen_pids[0] > 0)
+		{
+			my $get_sh_pid = 'ps -o pid,ppid ax | awk "{ if ( \$2 == '.$screen_pids[0].' ) { print \$1 }}"';
+			@sh_pids = `$get_sh_pid`;
+			if(defined($sh_pids[0]))
+			{
+				chomp($sh_pids[0]);
+				if($sh_pids[0] > 0)
+				{
+					my $get_server_pid = 'ps -o pid,ppid ax | awk "{ if ( \$2 == '.$sh_pids[0].' ) { print \$1 }}"';
+					@server_pids = `$get_server_pid`;
+				}
+			}
+		}
+		unshift(@server_pids,@screen_pids);
+		unshift(@server_pids,@sh_pids);	
+		
+		my $cnt;
+		foreach my $pid (@server_pids)
+		{
+			chomp($pid);
+			$cnt = kill -15, $pid;
+			
+			if ($cnt != 1)
+			{
+				$cnt = kill 9, $pid;
+				if ($cnt == 1)
+				{
+					logger "Stopped process with pid $pid successfully using kill -9.";
+				}
+				else
+				{
+					logger "Process $pid can not be stopped.";
+				}
+			}
+			else
+			{
+				logger "Stopped process with pid $pid successfully using kill -15.";
+			}
+		}
+		system("screen -wipe");
+		return 0;
+	}
+	else
+	{
+		logger "Remote control protocol not available or PASSWORD NOT SET. Using kill signal instead.";
+		
+		my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
+		
+		my $get_screen_pid = 'ps x | grep '.$screen_id.' | grep SCREEN | awk "{ print \$1 }"';
+									
+		my @screen_pids = `$get_screen_pid`;
+			
+		chomp($screen_pids[0]);
+		
+		my @sh_pids;
+		my @server_pids;
+		
+		if($screen_pids[0] > 0)
+		{
+			my $get_sh_pid = 'ps -o pid,ppid ax | awk "{ if ( \$2 == '.$screen_pids[0].' ) { print \$1 }}"';
+			@sh_pids = `$get_sh_pid`;
+			if(defined($sh_pids[0]))
+			{
+				chomp($sh_pids[0]);
+				if($sh_pids[0] > 0)
+				{
+					my $get_server_pid = 'ps -o pid,ppid ax | awk "{ if ( \$2 == '.$sh_pids[0].' ) { print \$1 }}"';
+					@server_pids = `$get_server_pid`;
+				}
+			}
+		}
+		unshift(@server_pids,@screen_pids);
+		unshift(@server_pids,@sh_pids);	
+		
+		my $cnt;
+		foreach my $pid (@server_pids)
+		{
+			chomp($pid);
+			$cnt = kill -15, $pid;
+			
+			if ($cnt != 1)
+			{
+				$cnt = kill 9, $pid;
+				if ($cnt == 1)
+				{
+					logger "Stopped process with pid $pid successfully using kill -9.";
+				}
+				else
+				{
+					logger "Process $pid can not be stopped.";
+				}
+			}
+			else
+			{
+				logger "Stopped process with pid $pid successfully using kill -15.";
+			}
+		}
+		system("screen -wipe");
+		return 0;
+	}
+}
+
+##### Send RCON command 
+### Return 0 when error occurred on decryption.
+### Return 1 on success
+sub send_rcon_command
+{
+	my ($home_id, $server_ip, $server_port, $control_protocol,
+		$control_password, $control_type, $rconCommand) = decrypt_params(@_);
+
+	# legacy console
+	if ($control_protocol eq "lcon")
+	{
+		my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
+		system('screen -S '.$screen_id.' -p 0 -X stuff "'.$rconCommand.'$(printf \\\\r)"');
+		logger "Sending legacy console command to ".$screen_id.": \n$rconCommand \n .";
+		if ($? == -1)
+		{
+			my(@modedlines) = "$rconCommand";
+			my $encoded_content = encode_list(@modedlines);
+			return "1;" . $encoded_content;
+		}
+		return 0;
+	}
+	
+	# Some validation checks for the variables.
+	if ($server_ip =~ /^\s*$/ || $server_port < 0 || $server_port > 65535)
+	{
+		logger("Invalid IP:Port given $server_ip:$server_port.");
+		return 0;
+	}
+	
+	if ($control_password !~ /^\s*$/)
+	{
+		if ($control_protocol eq "rcon")
+		{
+			use KKrcon::KKrcon;
+			my $rcon = new KKrcon(
+								  Password => $control_password,
+								  Host	 => $server_ip,
+								  Port	 => $server_port,
+								  Type	 => $control_type
+								 );
+
+			logger "Sending RCON command to $server_ip:$server_port: \n$rconCommand \n  .";
+						
+			my(@modedlines) = $rcon->execute($rconCommand);
+			my $encoded_content = encode_list(@modedlines);
+			return "1;" . $encoded_content;
+		}
+		else
+		{		
+			if ($control_protocol eq "rcon2")
+			{
+				use KKrcon::HL2;
+				my $rcon2 = new HL2(
+									  hostname => $server_ip,
+									  port	 => $server_port,
+									  password => $control_password,
+									  timeout  => 2
+									 );
+													
+				logger "Sending RCON command to $server_ip:$server_port: \n $rconCommand \n  .";
+						
+				my(@modedlines) = $rcon2->run($rconCommand);
+				my $encoded_content = encode_list(@modedlines);
+				return "1;" . $encoded_content;
+			}
+		}
+	}
+	else
+	{
+		logger "Control protocol PASSWORD NOT SET.";
+		return -10;
+	}
+}
+
+##### Returns a directory listing
+### @return List of directories if everything OK.
+### @return 0 If the directory is not found.
+### @return -1 If cannot open the directory.
+sub dirlist
+{
+	my ($datadir) = &decrypt_param(@_);
+	logger "Asked for dirlist of $datadir directory.";
+	if (!-d $datadir)
+	{
+		logger "ERROR - Directory [ $datadir ] not found!";
+		return -1;
+	}
+	if (!opendir(DIR, $datadir))
+	{
+		logger "ERROR - Can't open $datadir: $!";
+		return -2;
+	}
+	my @dirlist = readdir(DIR);
+	closedir(DIR);
+	return join(";", @dirlist);
+}
+
+##### Returns a directory listing with extra info the filemanager
+### @return List of directories if everything OK.
+### @return 0 If the directory is empty.
+### @return -1 If the directory is not found.
+### @return -2 If cannot open the directory.
+sub dirlistfm
+{
+	my $datadir = &decrypt_param(@_);
+	logger "Asked for dirlist of $datadir directory.";
+	if (!-d $datadir)
+	{
+		logger "ERROR - Directory [ $datadir ] not found!";
+		return -1;
+	}
+	if (!opendir(DIR, $datadir))
+	{
+		logger "ERROR - Can't open $datadir: $!";
+		return -2;
+	}
+	chdir($datadir);
+	my @dirlist = readdir(DIR);
+
+	if (@dirlist eq 0)
+	{
+		logger "Empty directory $datadir.";
+		return 0;
+	}
+
+	@dirlist = sort @dirlist;
+
+	my $dirlist;
+	my @dl;
+	my (
+		$dev,  $ino,   $mode,  $nlink, $uid,	 $gid, $rdev,
+		$size, $atime, $mtime, $ctime, $blksize, $blocks
+	   );
+	foreach $dirlist (@dirlist)
+	{
+
+		#skip the . and .. special dirs
+		next if $dirlist eq '.';
+		next if $dirlist eq '..';
+
+		#print "Dir list is" . $dirlist."\n";
+		#Stat the file to get ownership and size
+		(
+		 $dev,  $ino,   $mode,  $nlink, $uid,	 $gid, $rdev,
+		 $size, $atime, $mtime, $ctime, $blksize, $blocks
+		) = stat($dirlist);
+		$uid = getpwuid($uid);
+		$gid = getgrgid($gid);
+
+		#This if else logic determines what it is, File, Directory, other
+		#We modify the @dl array by adding file info to each element
+		if (-T $dirlist)
+		{
+
+			# print "File\n";
+			push(@dl,
+				 $dirlist . "|" . "$size" . "|" . "$uid" . "|" . "$gid" . "|"
+				   . "F");
+		}
+		elsif (-d $dirlist)
+		{
+
+			# print "Dir\n";
+			push(@dl,
+				 $dirlist . "|" . "$size" . "|" . "$uid" . "|" . "$gid" . "|"
+				   . "D");
+		}
+		elsif (-B $dirlist)
+		{
+
+			#print "File\n";
+			push(@dl,
+				 $dirlist . "|" . "$size" . "|" . "$uid" . "|" . "$gid" . "|"
+				   . "B");
+		}
+		else
+		{
+
+			#print "Unknown\n";
+			push(@dl,
+				 $dirlist . "|" . "$size" . "|" . "$uid" . "|" . "$gid" . "|"
+				   . "U");
+		}
+
+	}
+	closedir(DIR);
+	chdir AGENT_RUN_DIR;
+	#Now we return it to the webpage, which then can parse it further
+	return join(";", @dl);
+}
+
+###### Returns the contents of a text file
+sub readfile
+{
+	chdir AGENT_RUN_DIR;
+	my $userfile = &decrypt_param(@_);
+
+	unless ( -e $userfile )
+	{
+		if (open(BLANK, '>', $userfile))
+		{
+			close(BLANK);
+		}
+	}
+	
+	if (!open(USERFILE, '<', $userfile))
+	{
+		logger "ERROR - Can't open file $userfile for reading.";
+		return -1;
+	}
+
+	my ($wholefile, $buf);
+
+	while (read(USERFILE, $buf, 60 * 57))
+	{
+		$wholefile .= encode_base64($buf);
+	}
+	close(USERFILE);
+	
+	if(!defined $wholefile)
+	{
+		return "1; ";
+	}
+	
+	return "1;" . $wholefile;
+}
+
+###### Backs up file, then writes data to new file
+### @return 1 On success
+### @return 0 In case of a failure
+sub writefile
+{
+	chdir AGENT_RUN_DIR;
+	# $writefile = file we're editing, $filedata = the contents were writing to it
+	my ($writefile, $filedata) = &decrypt_params(@_);
+	if (!-e $writefile)
+	{
+		open FILE, ">", $writefile;
+	}
+	else
+	{
+		# backup the existing file
+		logger
+		  "Backing up file $writefile to $writefile.bak before writing new data.";
+		if (!copy("$writefile", "$writefile.bak"))
+		{
+			logger
+			  "ERROR - Failed to backup $writefile to $writefile.bak. Error: $!";
+			return 0;
+		}
+	}
+	if (!-w $writefile)
+	{
+		logger "ERROR - File [ $writefile ] is not writeable!";
+		return 0;
+	}
+	if (!open(WRITER, '>', $writefile))
+	{
+		logger "ERROR - Failed to open $writefile for writing.";
+		return 0;
+	}
+	$filedata = decode_base64($filedata);
+	$filedata =~ s/\r//g;
+	print WRITER "$filedata";
+	close(WRITER);
+	logger "Wrote $writefile successfully!";
+	return 1;
+}
+
+# Determine the os of the agent machine.
+sub what_os
+{
+	my $os;
+	my $os_name;
+	my $os_arch;
+	my $wine_ver = "";
+	logger "Asking for OS type";
+	if (-e "/usr/bin/wine")
+	{
+		$wine_ver = `/usr/bin/wine --version`;
+		chomp $wine_ver;
+		$wine_ver = "|".$wine_ver;
+	}
+	elsif (-e "/bin/wine")
+	{
+		$wine_ver = `/bin/wine --version`;
+		chomp $wine_ver;
+		$wine_ver = "|".$wine_ver;
+	}
+	if (-e "/usr/bin/uname")
+	{
+		$os_name = `/usr/bin/uname`;
+		chomp $os_name;
+		$os_arch = `/usr/bin/uname -m`;
+		chomp $os_arch;
+		$os = $os_name." ".$os_arch.$wine_ver;
+		logger "OS is $os";
+		return "$os";
+	}
+	elsif (-e "/bin/uname")
+	{
+		$os_name = `/bin/uname`;
+		chomp $os_name;
+		$os_arch = `/bin/uname -m`;
+		chomp $os_arch;
+		$os = $os_name." ".$os_arch.$wine_ver;
+		logger "OS is $os";
+		return "$os";
+	}
+	elsif (-e 'c:\\')
+	{
+		logger "OS is Windows";
+		return "Windows";
+	}
+	else
+	{
+		logger "Cannot determine OS..that is odd";
+		return "Unknown";
+	}
+}
+
+### @return PID of the download process if started succesfully.
+### @return -1 If could not create temporary download directory.
+### @return -2 If could not create destination directory.
+### @return -3 If resources unavailable.
+sub start_file_download
+{
+	my ($url, $destination, $filename, $action, $post_script) = &decrypt_params(@_);
+	logger
+	  "Starting to download URL $url. Destination: $destination - Filename: $filename";
+
+	if (!-e $destination)
+	{
+		logger "Creating destination directory.";
+		if (!mkpath $destination )
+		{
+			logger "Could not create destination '$destination' directory : $!";
+			return -2;
+		}
+	}
+	
+	my $download_file_path = Path::Class::File->new($destination, "$filename");
+
+	my $pid = fork();
+	if (not defined $pid)
+	{
+		logger "Could not allocate resources for download.";
+		return -3;
+	}
+
+	# Only the forked child goes here.
+	elsif ($pid == 0)
+	{
+		my $get_retval = getstore($url, "$download_file_path");
+
+		if (!is_success($get_retval))
+		{
+			logger
+			  "Unable to fetch $url, or save to $download_file_path. Retval: $get_retval";
+			exit(0);
+		}
+
+		logger
+		  "Successfully fetched $url and stored it to $download_file_path. Retval: $get_retval.";
+
+		if (!-e $download_file_path)
+		{
+			logger "File $download_file_path does not exist.";
+			exit(0);
+		}
+
+		if ($action eq "uncompress")
+		{
+			logger "Starting file uncompress as ordered.";
+			uncompress_file_without_decrypt($download_file_path,
+											$destination);
+		}
+
+		# Child process must exit.
+		exit(0);
+	}
+	else
+	{
+		if ($post_script ne "")
+		{
+			logger "Running postscript commands.";
+			my @postcmdlines = split /[\r\n]+/, $post_script;
+			my $postcmdfile = $destination."/".'postinstall.sh';
+			open  FILE, '>', $postcmdfile;
+			print FILE "cd $destination\n";
+			print FILE "while kill -0 $pid >/dev/null 2>&1\n";
+			print FILE "do\n";
+			print FILE "	sleep 1\n";
+			print FILE "done\n";
+			foreach my $line (@postcmdlines) {
+				print FILE "$line\n";
+			}
+			print FILE "rm -f $destination/postinstall.sh\n";
+			close FILE;
+			chmod 0755, $postcmdfile;
+			my $screen_id = create_screen_id("post_script", $pid);
+			my $cli_bin = create_screen_cmd($screen_id, "bash $postcmdfile");
+			system($cli_bin);
+		}
+		logger "Download process for $download_file_path has pid number $pid.";
+		return "$pid";
+	}
+}
+
+sub make_path_writeable
+{
+	my ($path) = @_;
+	my $whoami = `whoami`;
+	chop $whoami;
+	my $group = `groups $whoami | awk '{ print \$3 }'`;
+	chop $group;
+	
+	my $chown_path = "chown -Rf $whoami:$group " . $path;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chown_path");
+	
+	my $chattr_path = "chattr -Rf -i " . $path;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chattr_path");
+	
+	return 0;
+}
+
+sub create_secure_script
+{	
+	my ($home_path, $exec_folder_path, $exec_path) = @_;
+	my $whoami = `whoami`;
+	chop $whoami;
+	my $group = `groups $whoami | awk '{ print \$3 }'`;
+	chop $group;
+	my $chown_home_path = "chown -Rf $whoami:$group " . $home_path;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chown_home_path");
+	$chown_home_path = "chattr -Rf -i " . $home_path;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $chown_home_path");
+	
+	my $secure = "$home_path/secure.sh";
+	open  FILE, '>', $secure;
+	print FILE "chown 0:$group " . $exec_folder_path . "\n";
+	print FILE "chmod 771 " . $exec_folder_path . "\n";
+	print FILE "chown 0:$group " . $exec_path . "\n";
+	print FILE "chmod 750 " . $exec_path . "\n";
+	print FILE "chmod +x " . $exec_path . "\n";
+	print FILE "chattr +i " . $exec_path . "\n";
+	print FILE "rm -f $secure";
+	close FILE;
+	chmod 0770, $secure;
+		
+	my $invisible_secure = "chown 0:0 " . $secure;
+	system("echo \"".SUDOPASSWD."\" | sudo -S -p \"\" $invisible_secure");
+	
+	return 0;
+}
+
+sub check_b4_chdir
+{
+	my ( $path ) = @_;
+		
+	if (!-e $path)
+	{
+		logger "$path does not exist yet. Trying to create it...";
+
+		if (!mkpath($path))
+		{
+			logger "Error creating $path . Errno: $!";
+			return -1;
+		}
+	}
+	else
+	{	
+		# File or directory already exists
+		# Make sure it's owned by the agent
+		make_path_writeable($path);
+	}
+	
+	if (!chdir $path)
+	{
+		logger "Unable to change dir to '$path'.";
+		return -1;
+	}
+	
+	return 0;
+}
+
+sub create_bash_scripts
+{
+	my ( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds ) = @_;
+	
+	my @precmdlines = split /[\r\n]+/, $precmd;
+	my $precmdfile = 'preinstall.sh';
+	open  FILE, '>', $precmdfile;
+	print FILE "cd $home_path\n";
+	foreach my $line (@precmdlines) {
+		print FILE "$line\n";
+	}
+	close FILE;
+	chmod 0755, $precmdfile;
+	
+	my @postcmdlines = split /[\r\n]+/, $postcmd;
+	my $postcmdfile = 'postinstall.sh';
+	open  FILE, '>', $postcmdfile;
+	print FILE "cd $home_path\n";
+	foreach my $line (@postcmdlines) {
+		print FILE "$line\n";
+	}
+	print FILE "cd $home_path\n";
+	print FILE "echo \"".SUDOPASSWD."\" | sudo -S -p \"\" bash secure.sh\n";
+	print FILE "rm -f secure.sh\n";
+	print FILE "cd $bash_scripts_path\n";
+	print FILE "rm -f preinstall.sh\n";
+	print FILE "rm -f postinstall.sh\n";
+	print FILE "rm -f runinstall.sh\n";
+	close FILE;
+	chmod 0755, $postcmdfile;
+	
+	my $installfile = 'runinstall.sh';
+	open  FILE, '>', $installfile;
+	print FILE "#!/bin/bash\n";
+	print FILE "cd $bash_scripts_path\n";
+	print FILE "./$precmdfile\n";
+	foreach my $installcmd (@installcmds)
+	{
+		print FILE "$installcmd\n";
+	}
+	print FILE "wait ".'${!}'."\n";
+	print FILE "cd $bash_scripts_path\n";
+	print FILE "./$postcmdfile\n";
+	close FILE;
+	chmod 0755, $installfile;
+	
+	return $installfile;
+}
+
+#### Run the rsync update ####
+### @return 1 If update started
+### @return 0 In error case.
+sub start_rsync_install
+{
+	my ($home_id, $home_path, $url, $exec_folder_path, $exec_path, $precmd, $postcmd) = decrypt_params(@_);
+
+	if ( check_b4_chdir($home_path) != 0)
+	{
+		return 0;
+	}
+	
+	make_path_writeable($home_path);
+	
+	create_secure_script($home_path, $exec_folder_path, $exec_path);
+
+	my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
+	
+	if ( check_b4_chdir($bash_scripts_path) != 0)
+	{
+		return 0;
+	}
+	
+	# Rsync install require the rsync binary to exist in the system
+	# to enable this functionality.
+	my $rsync_binary = Path::Class::File->new("/usr/bin", "rsync");
+	
+	if (!-f $rsync_binary)
+	{
+		logger "Failed to start rsync update from "
+		  . $url
+		  . " to $home_path. Error: Rsync client not installed.";
+		return 0;
+	}
+
+	my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
+	
+	my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+	
+	backup_home_log( $home_id, $log_file );
+	
+	my @installcmds = ("/usr/bin/rsync --archive --compress --copy-links --update --verbose rsync://$url $home_path");
+	my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds );
+
+	my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
+	logger "Running rsync update: /usr/bin/rsync --archive --compress --copy-links --update --verbose rsync://$url $home_path";
+	system($screen_cmd);
+	
+	chdir AGENT_RUN_DIR;
+	return 1;
+}
+
+### @return PID of the download process if started succesfully.
+### @return -1 If could not create temporary download directory.
+### @return -2 If could not create destination directory.
+### @return -3 If resources unavailable.
+sub master_server_update
+{
+	my ($home_id,$home_path,$ms_home_id,$ms_home_path,$exec_folder_path,$exec_path,$precmd,$postcmd) = decrypt_params(@_);
+	
+	if ( check_b4_chdir($home_path) != 0)
+	{
+		return 0;
+	}
+	
+	make_path_writeable($home_path);
+		
+	create_secure_script($home_path, $exec_folder_path, $exec_path);
+			
+	my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
+	
+	if ( check_b4_chdir($bash_scripts_path) != 0)
+	{
+		return 0;
+	}
+
+	my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
+	
+	my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+	
+	backup_home_log( $home_id, $log_file );
+		
+	my @installcmds = ("cd $ms_home_path");
+	
+	## Copy files that match the extensions listed at extPatterns.txt
+	open(EXT_PATTERNS, '<', Path::Class::File->new(AGENT_RUN_DIR, "extPatterns.txt"))
+		  || logger "Error reading patterns file $!";
+	my @ext_paterns = <EXT_PATTERNS>;
+	foreach my $patern (@ext_paterns)
+	{
+		chop $patern;
+		push (@installcmds, "find  -iname \\\*.$patern -exec cp -Rfp --parents {} $home_path/ \\\;");
+	}
+	close EXT_PATTERNS;
+	
+	## Copy the server executable so it can be secured with chattr +i
+	my $ms_exec_path = $exec_path;
+	$ms_exec_path =~ s/$home_path/$ms_home_path/g;	
+	push (@installcmds, "cp -vf  $ms_exec_path $exec_path");
+	
+	## Do symlinks for each of the other files
+	push (@installcmds, "cp -vuRfs  $ms_home_path/* $home_path");
+	
+	my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds );
+
+	my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
+	logger "Running master server update: cp -vuRf  $ms_home_path/* $home_path";
+	system($screen_cmd);
+	
+	chdir AGENT_RUN_DIR;
+	return 1;
+}
+
+#### Run the steam client ####
+### @return 1 If update started
+### @return 0 In error case.
+sub steam_cmd
+{
+	if (check_steam_cmd_client() < 1)
+	{
+		return 0;
+	}
+	
+	my ($home_id, $home_path, $mod, $modname, $betaname, $betapwd, $user, $pass, $guard, $exec_folder_path, $exec_path, $precmd, $postcmd) = decrypt_params(@_);
+	
+	if ( check_b4_chdir($home_path) != 0)
+	{
+		return 0;
+	}
+	
+	make_path_writeable($home_path);
+	
+	create_secure_script($home_path, $exec_folder_path, $exec_path);
+	
+	my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
+	
+	if ( check_b4_chdir($bash_scripts_path) != 0)
+	{
+		return 0;
+	}
+	
+	my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
+	my $screen_id_for_txt_update = substr ($screen_id, rindex($screen_id, '_') + 1);
+	my $steam_binary = Path::Class::File->new(STEAMCMD_CLIENT_DIR, "steamcmd.sh");
+	my $installSteamFile =  $screen_id_for_txt_update . "_install.txt";
+
+	my $installtxt = Path::Class::File->new(STEAMCMD_CLIENT_DIR, $installSteamFile);
+	open  FILE, '>', $installtxt;
+	print FILE "\@ShutdownOnFailedCommand 1\n";
+	print FILE "\@NoPromptForPassword 1\n";
+	if($guard ne '')
+	{	
+		print FILE "set_steam_guard_code $guard\n";
+	}
+	if($user ne '' && $user ne 'anonymous')
+	{
+		print FILE "login $user $pass\n";
+	}
+	else
+	{
+		print FILE "login anonymous\n";
+	}
+	
+	print FILE "force_install_dir $home_path\n";
+
+	if($modname ne "")
+	{
+		print FILE "app_set_config $mod mod $modname\n"
+	}
+
+	if($betaname ne "" && $betapwd ne "")
+	{
+		print FILE "app_update $mod -beta $betaname -betapassword $betapwd validate\n";
+	}
+	elsif($betaname ne "" && $betapwd eq "")
+	{
+		print FILE "app_update $mod -beta $betaname validate\n";
+	}
+	else
+	{
+		print FILE "app_update $mod validate\n";
+	}
+	
+	print FILE "exit\n";
+	close FILE;
+	
+	my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
+	backup_home_log( $home_id, $log_file );
+	
+	my $postcmd_mod = $postcmd;
+	my @installcmds = ("$steam_binary +runscript $installtxt +exit");
+	
+	my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd_mod, @installcmds );
+	
+	my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
+	
+	logger "Running steam update: $steam_binary +runscript $installtxt +exit";
+	system($screen_cmd);
+
+	return 1;
+}
+
+sub rsync_progress
+{
+	my ($running_home) = &decrypt_param(@_);
+	logger "User requested progress on rsync job on home $running_home.";
+	if (-r $running_home)
+	{
+		$running_home =~ s/\s/\\ /g;
+		my $progress = `du -sk $running_home`;
+		chomp($progress);
+		my ($bytes, $junk) = split(/\s+/, $progress);
+		logger("Found $bytes and $junk");
+		return $bytes;
+	}
+	return "0";
+}
+
+sub is_file_download_in_progress
+{
+	my ($pid) = &decrypt_param(@_);
+	logger "User requested if download is in progress with pid $pid.";
+	my @pids = `ps -ef`;
+	@pids = grep(/$pid/, @pids);
+	logger "Number of pids for file download: @pids";
+	if (@pids > '0')
+	{
+		return 1;
+	}
+	return 0;
+}
+
+### \return 1 If file is uncompressed succesfully.
+### \return 0 If file does not exist.
+### \return -1 If file could not be uncompressed.
+sub uncompress_file
+{
+	return uncompress_file_without_decrypt(decrypt_params(@_));
+}
+
+sub uncompress_file_without_decrypt
+{
+
+	# File must include full path.
+	my ($file, $destination) = @_;
+
+	logger "Uncompression called for file $file to dir $destination.";
+
+	if (!-e $file)
+	{
+		logger "File $file could not be found for uncompression.";
+		return 0;
+	}
+
+	if (!-e $destination)
+	{
+		mkpath($destination, {error => \my $err});
+		if (@$err)
+		{
+			logger "Failed to create destination dir $destination.";
+			return 0;
+		}
+	}
+
+	my $ae = Archive::Extract->new(archive => $file);
+
+	if (!$ae)
+	{
+		logger "Could not create archive instance for file $file.";
+		return -1;
+	}
+
+	my $ok = $ae->extract(to => $destination);
+
+	if (!$ok)
+	{
+		logger "File $file could not be uncompressed.";
+		return -1;
+	}
+
+	logger "File uncompressed/extracted successfully.";
+	return 1;
+
+	# TODO: This is still WIP. Remove lines above to continue.
+
+	my $common_path = '';
+
+	# TODO: These might not work on all systems if dir separator isn't /
+	if ($ae->files->[0] =~ /^.*\/$/)
+	{
+		$common_path = $ae->files->[0];
+	}
+	else
+	{
+		my @file_path_tmp = split('/', $ae->files->[0]);
+
+		if (@file_path_tmp > 1)
+		{
+			$common_path = $file_path_tmp[0] . '/';
+		}
+	}
+
+	if ($common_path ne '')
+	{
+		my $match = 1;
+
+		my $file_list = $ae->files;
+
+		# Check that every file contains the common path.
+		foreach (@$file_list)
+		{
+			next if (s!$common_path!$_!);
+
+			logger "File mismatch: $_ to $common_path";
+			$match = 0;
+			last;
+		}
+
+		# If all files did not include the common path we should extract
+		# the file to the home. Reset path.
+		if ($match != 1)
+		{
+			$common_path = '';
+		}
+
+		logger "Common path is: $common_path";
+	}
+
+	#local $File::Copy::Recursive::SkipFlop = 1;
+	#my ($num_of_f_and_d,$nb_of_d,$depth_traversed) = dircopy("teamspeak3-server_linux-x86/", "copy/");
+	#logger "$num_of_f_and_d,$nb_of_d,$depth_traversed";
+
+	logger "File uncompressed/extracted successfully.";
+	return 1;
+}
+
+sub discover_ips
+{
+	my ($check) = decrypt_params(@_);
+
+	if ($check ne "chk")
+	{
+		logger "Invalid parameter '$check' given for discover_ips function.";
+		return "";
+	}
+
+	my $iplist = "";
+	my $ipfound;
+	my $junk;
+
+	my @ipraw = `/sbin/ifconfig`;
+	while (<@ipraw>)
+	{
+		chomp;
+		next if $_ !~ /^inet:/ ;
+		logger "Found addr on line: $_";
+		($junk, $ipfound) = split(":", $_);
+		next if $ipfound eq '';
+		next if $ipfound eq '127.0.0.1';
+
+		logger "Found an IP $ipfound";
+		$iplist .= "$ipfound,";
+		logger "IPlist is now $iplist";
+	}
+	while (<@ipraw>)
+	{
+		chomp;
+		next if $_ !~ /^addr:/ ;
+		logger "Found addr on line: $_";
+		($junk, $ipfound) = split(":", $_);
+		next if $ipfound eq '';
+		next if $ipfound eq '127.0.0.1';
+
+		logger "Found an IP $ipfound";
+		$iplist .= "$ipfound,";
+		logger "IPlist is now $iplist";
+	}
+	chop $iplist;
+	return "$iplist";
+}
+
+### Return -1 In case of invalid param
+### Return 1;content in case of success
+sub mon_stats
+{
+	my ($mon_stats) = decrypt_params(@_);
+	if ($mon_stats ne "mon_stats")
+	{
+		logger "Invalid parameter '$mon_stats' given for $mon_stats function.";
+		return -1;
+	}
+
+	my @disk			= `df -hP -x tmpfs`;
+	my $encoded_content = encode_list(@disk);
+	my @uptime		  = `uptime`;
+	$encoded_content .= encode_list(@uptime);
+	return "1;$encoded_content";
+}
+
+sub exec
+{
+	my ($command) = decrypt_params(@_);
+	my @cmdret		   = `$command`;
+	my $encoded_content = encode_list(@cmdret);
+	logger "$command sent.";
+	return "1;$encoded_content";
+}
+
+# used in conjunction with the clone_home feature in the web panel
+# this actually does the file copies
+sub clone_home
+{
+	my ($source_home, $dest_home, $owner) = decrypt_params(@_);
+	my ($time_start, $time_stop, $time_diff);
+	logger "Copying from $source_home to $dest_home...";
+
+	# check size of source_home, make sure we have space to copy
+	if (!-e $source_home)
+	{
+		logger "ERROR - $source_home does not exist";
+		return 0;
+	}
+	logger "Game home $source_home exists...copy will proceed";
+
+	# start the copy, and a timer
+	$time_start = time();
+	if (!dircopy("$source_home", "$dest_home"))
+	{
+		$time_stop = time();
+		$time_diff = $time_stop - $time_start;
+		logger
+		  "Error occured after $time_diff seconds during copy of $source_home to $dest_home - $!";
+		return 0;
+	}
+	else
+	{
+		$time_stop = time();
+		$time_diff = $time_stop - $time_start;
+		logger
+		  "Home clone completed successfully to $dest_home in $time_diff seconds";
+		logger "Using chown -R $owner $dest_home to set home ownership";
+		`chown -R $owner $dest_home`;
+		return 1;
+	}
+
+	# caputre copy return code, stop timer
+
+	# return to success/fail
+}
+
+# used to delete the game home from the file system when it's removed from the panel
+sub remove_home
+{
+	my ($home_path_del) = decrypt_params(@_);
+
+	if (!-e $home_path_del)
+	{
+		logger "ERROR - $home_path_del does not exist...nothing to do";
+		return 0;
+	}
+
+	make_path_writeable($home_path_del);
+	sleep 1 while ( !pathrmdir("$home_path_del") );
+	logger "Deletetion of $home_path_del successful!";
+	return 1;
+}
+
+### Restart the server
+## return -2 CANT STOP
+## return -1  CANT START (no startup file found that mach the home_id, port and ip)
+## return 1 Restart OK
+sub restart_server
+{
+	my ($home_id, $server_ip, $server_port, $control_protocol,
+		$control_password, $control_type, $home_path, $server_exe, $run_dir,
+		$cmd, $cpu, $nice) = decrypt_params(@_);
+
+	if (stop_server_without_decrypt($home_id, $server_ip, 
+									$server_port, $control_protocol,
+									$control_password, $control_type) == 0)
+	{
+		if (universal_start_without_decrypt($home_id, $home_path, $server_exe, $run_dir,
+											$cmd, $server_port, $server_ip, $cpu, $nice) == 1)
+		{
+			return 1;
+		}
+		else
+		{
+			return -1;
+		}
+	}
+	else
+	{
+		return -2;
+	}
+}
+
+sub sudo_exec
+{
+	my $sudo_exec = &decrypt_param(@_);
+	return sudo_exec_without_decrypt($sudo_exec);
+}
+
+sub sudo_exec_without_decrypt
+{
+	my ($sudo_exec) = @_;
+	my $command = "sudo su -c '".$sudo_exec."' root";
+	system("echo \"".SUDOPASSWD."\" | sudo -S echo '\nsudo on'");
+	my @cmdret = `$command`;
+	system("sudo -k && echo 'sudo off'");
+	logger "Executed: $command";
+	my $encoded_content = encode_list(@cmdret);
+	if ($? == -1)
+	{
+		return "1;$encoded_content";
+	}
+	return 0;
+}
+
+sub secure_path
+{   
+	my ($action, $file_path) = decrypt_params(@_);
+	my $ogp_user = `whoami`;
+	chop $ogp_user;
+	my $ogp_group = `groups $ogp_user | awk '{ print \$3 }'`;
+	chop $ogp_group;
+
+	if($action eq "chattr+i")
+	{
+		sudo_exec_without_decrypt('chown '.$ogp_user.':'.$ogp_group.' '.$file_path);
+		sudo_exec_without_decrypt('chmod 700 '.$file_path);
+		return sudo_exec_without_decrypt('chattr +i '.$file_path);
+	}
+	elsif($action eq "chattr-i")
+	{
+		return sudo_exec_without_decrypt('chattr -i '.$file_path.' && chmod 755 '.$file_path);
+	}
+}
+
+sub get_chattr
+{   
+	my ($file_path) = decrypt_params(@_);
+	my $file_path_addslashes = $file_path;
+	$file_path_addslashes =~ s/\//\\\//g;
+	return sudo_exec_without_decrypt('(lsattr ' .$file_path. ' | sed -e "s/'.$file_path_addslashes.'//g")|grep -o i'); 
+}
+
+sub ftp_mgr
+{
+	my ($action, $login, $password, $home_path) = decrypt_params(@_);
+	my $ogp_user = `whoami`;
+	chop $ogp_user;
+	my $ogp_group = `groups $ogp_user | awk '{ print \$3 }'`;
+	chop $ogp_group;
+	
+	if(!defined($Cfg::Preferences{ogp_manages_ftp}) || (defined($Cfg::Preferences{ogp_manages_ftp}) &&  $Cfg::Preferences{ogp_manages_ftp} eq "1")){
+		if( defined($Cfg::Preferences{ftp_method}) && $Cfg::Preferences{ftp_method} eq "IspConfig")
+		{
+			use constant ISPCONFIG_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'IspConfig');
+			use constant FTP_USERS_DIR => Path::Class::Dir->new(ISPCONFIG_DIR, 'ftp_users');
+				
+			if (!-d FTP_USERS_DIR && !mkdir FTP_USERS_DIR)
+			{
+				print "Could not create " . FTP_USERS_DIR . " directory $!.";
+				return -1;
+			}
+			
+			chdir ISPCONFIG_DIR;
+			
+			if($action eq "list")
+			{
+				my $users_list;
+				opendir(USERS, FTP_USERS_DIR);
+				while (my $username = readdir(USERS))
+				{
+					# Skip . and ..
+					next if $username =~ /^\./;
+					$users_list .= `php-cgi -f sites_ftp_user_get.php username=$username`;
+				}
+				closedir(USERS);
+				if( defined($users_list) )
+				{
+					return "1;".encode_list($users_list);
+				}
+			}
+			elsif($action eq "userdel")
+			{
+				return "1;".encode_list(`php-cgi -f sites_ftp_user_delete.php username=$login`);
+			}
+			elsif($action eq "useradd")
+			{
+				return "1;".encode_list(`php-cgi -f sites_ftp_user_add.php username=$login password=$password dir=$home_path uid=$ogp_user gid=$ogp_group`);
+			}
+			elsif($action eq "passwd")
+			{
+				return "1;".encode_list(`php-cgi -f sites_ftp_user_update.php type=passwd username=$login password=$password`);
+			}
+			elsif($action eq "show")
+			{
+				return "1;".encode_list(`php-cgi -f sites_ftp_user_get.php type=detail username=$login`);
+			}
+			elsif($action eq "usermod")
+			{
+				return "1;".encode_list(`php-cgi -f sites_ftp_user_update.php username=$login password=\'$password\'`);
+			}
+		}
+		elsif(defined($Cfg::Preferences{ftp_method}) && $Cfg::Preferences{ftp_method} eq "EHCP" && -e "/etc/init.d/ehcp")
+		{
+			use constant EHCP_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'EHCP');
+
+			chdir EHCP_DIR;
+			my $phpScript;
+			my $phpOut;
+			
+			chmod 0777, 'ehcp_ftp_log.txt';
+			
+			if($action eq "list")
+			{
+				return "1;".encode_list(`php-cgi -f listAllUsers.php`);
+			}
+			elsif($action eq "userdel")
+			{
+				# "1;".
+				$phpScript = `php-cgi -f delAccount.php username=$login`;
+				$phpOut = `php-cgi -f syncftp.php`;
+				return $phpScript;
+			}
+			elsif($action eq "useradd")
+			{
+				$phpScript = `php-cgi -f addAccount.php username=$login password=$password dir=$home_path uid=$ogp_user gid=$ogp_group`;
+				$phpOut = `php-cgi -f syncftp.php`;
+				return $phpScript;	
+			}
+			elsif($action eq "passwd")
+			{
+				$phpScript = `php-cgi -f updatePass.php username=$login password=$password`;
+				$phpOut = `php-cgi -f syncftp.php`;
+				return $phpScript ;	
+			}
+			elsif($action eq "show")
+			{
+				return "1;".encode_list(`php-cgi -f showAccount.php username=$login`);
+			}
+			elsif($action eq "usermod")
+			{
+				$phpScript = `php-cgi -f updateInfo.php username=$login password=\'$password\'`;
+				$phpOut = `php-cgi -f syncftp.php`;
+				return $phpScript;
+			}
+		}
+		else
+		{
+			if($action eq "list")
+			{
+				return sudo_exec_without_decrypt("pure-pw list");
+			}
+			elsif($action eq "userdel")
+			{
+				return sudo_exec_without_decrypt("pure-pw userdel ".$login." && pure-pw mkdb");
+			}
+			elsif($action eq "useradd")
+			{
+				return sudo_exec_without_decrypt("(echo ".$password."; echo ".$password.") | pure-pw useradd ".$login." -u ".$ogp_user." -d ".$home_path." && pure-pw mkdb");
+			}
+			elsif($action eq "passwd")
+			{
+				return sudo_exec_without_decrypt("(echo ".$password."; echo ".$password.") | pure-pw passwd ".$login." && pure-pw mkdb");
+			}
+			elsif($action eq "show")
+			{
+				return sudo_exec_without_decrypt("pure-pw show ".$login);
+			}
+			elsif($action eq "usermod")
+			{
+				my $update_account = "pure-pw usermod " . $login . " -u " . $ogp_user;
+				
+				my @account_settings = split /[\n]+/, $password;
+				
+				foreach my $setting (@account_settings) {
+					my ($key, $value) = split /[\t]+/, $setting;
+					
+					if( $key eq 'Directory' )
+					{
+						$update_account .= " -d " . $value;
+					}
+						
+					if( $key eq 'Full_name' )
+					{
+						if(  $value ne "" )
+						{
+							$update_account .= " -c " . $value;
+						}
+						else
+						{
+							$update_account .= ' -c ""';
+						}
+					}
+					
+					if( $key eq 'Download_bandwidth' && $value ne ""  )
+					{
+						my $Download_bandwidth;
+						if($value eq 0)
+						{
+							$Download_bandwidth = "\"\"";
+						}
+						else
+						{
+							$Download_bandwidth = $value;
+						}
+						$update_account .= " -t " . $Download_bandwidth;
+					}
+					
+					if( $key eq 'Upload___bandwidth' && $value ne "" )
+					{
+						my $Upload___bandwidth;
+						if($value eq 0)
+						{
+							$Upload___bandwidth = "\"\"";
+						}
+						else
+						{
+							$Upload___bandwidth = $value;
+						}
+						$update_account .= " -T " . $Upload___bandwidth;
+					}
+					
+					if( $key eq 'Max_files' )
+					{
+						if( $value eq "0" )
+						{
+							$update_account .= ' -n ""';
+						}
+						elsif( $value ne "" )
+						{
+							$update_account .= " -n " . $value;
+						}
+						else
+						{
+							$update_account .= ' -n ""';
+						}
+					}
+										
+					if( $key eq 'Max_size' )
+					{
+						if( $value ne "" )
+						{
+							$update_account .= " -N " . $value;
+						}
+						else
+						{
+							$update_account .= ' -N ""';
+						}
+					}
+										
+					if( $key eq 'Ratio' && $value ne ""  )
+					{
+						my($upload_ratio,$download_ratio) = split/:/,$value;
+						
+						if($upload_ratio eq "0")
+						{
+							$upload_ratio = "\"\"";
+						}
+						$update_account .= " -q " . $upload_ratio;
+						
+						if($download_ratio eq "0")
+						{
+							$download_ratio = "\"\"";
+						}
+						$update_account .= " -Q " . $download_ratio;
+					}
+					
+					if( $key eq 'Allowed_client_IPs' )
+					{
+						if( $value ne "" )
+						{
+							$update_account .= " -r " . $value;
+						}
+						else
+						{
+							$update_account .= ' -r ""';
+						}
+					}
+										
+					if( $key eq 'Denied__client_IPs' )
+					{
+						if( $value ne "" )
+						{
+							$update_account .= " -R " . $value;
+						}
+						else
+						{
+							$update_account .= ' -R ""';
+						}
+					}
+					
+					if( $key eq 'Allowed_local__IPs' )
+					{
+						if( $value ne "" )
+						{
+							$update_account .= " -i " . $value;
+						}
+						else
+						{
+							$update_account .= ' -i ""';
+						}
+					}
+										
+					if( $key eq 'Denied__local__IPs' )
+					{
+						if( $value ne "" )
+						{
+							$update_account .= " -I " . $value;
+						}
+						else
+						{
+							$update_account .= ' -I ""';
+						}
+					}
+					
+						
+					if( $key eq 'Max_sim_sessions' && $value ne "" )
+					{
+						$update_account .= " -y " . $value;
+					}
+					
+					if ( $key eq 'Time_restrictions'  )
+					{
+						if( $value eq "0000-0000")
+						{
+							$update_account .= ' -z ""';
+						}
+						elsif( $value ne "" )
+						{
+							$update_account .= " -z " . $value;
+						}
+						else
+						{
+							$update_account .= ' -z ""';
+						}
+					}
+				}
+				$update_account .=" && pure-pw mkdb";
+				# print $update_account;
+				return sudo_exec_without_decrypt($update_account);
+			}
+		}
+	}
+	return 0;
+}

+ 227 - 0
ogp_agent_run

@@ -0,0 +1,227 @@
+#!/bin/bash
+#
+#
+#	A wrapper script for the OGP agent perl script.
+#	Performs auto-restarting of the agent on crash. You can
+#	extend this to log crashes and more.
+#
+# The ogp_agent_run script should be at the top level of the agent tree
+# Make sure we are in that directory since the script assumes this is the case
+AGENTDIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
+AUTO_UPDATE_CONF="$AGENTDIR/Cfg/bash_prefs.cfg" 
+
+if test `id -u` -eq 0; then
+	echo
+	echo
+	echo "************** WARNING ***************"
+	echo "Running the OGP agent as root  "
+	echo "is highly discouraged. It is generally"
+	echo "unnecessary to use root privileges to "
+	echo "execute a dedicated server.         "
+	echo "**************************************"
+	echo
+	echo
+	timeout=10
+	while test $timeout -gt 0; do
+		echo -n "The agent will continue to launch in $timeout seconds\r"
+		timeout=`expr $timeout - 1`
+		sleep 1
+	done
+fi
+
+init() {
+	RESTART="yes"
+	AGENT="$AGENTDIR/ogp_agent.pl"
+	TIMEOUT=10 # time to wait after a crash (in seconds)
+	PID_FILE=""
+	
+	# Should we perform an automatic update?
+	if [ -e $AUTO_UPDATE_CONF ]
+	then
+		source "$AUTO_UPDATE_CONF"
+		
+		if [ "$agent_auto_update" -eq "1" ]
+		then
+			AUTO_UPDATE="yes"
+		fi
+		
+		if [ -z "$sf_update_mirror" ]
+		then
+			MIRROR="master"
+		else
+			MIRROR=$sf_update_mirror
+		fi
+	else
+		AUTO_UPDATE="yes"
+		MIRROR="master"
+	fi
+	
+	while test $# -gt 0; do
+		case "$1" in
+		"-pidfile")
+			PID_FILE="$2"
+			PID_FILE_SET=1
+			echo $$ > $PID_FILE
+			shift ;;
+		esac
+		shift
+	done
+
+	if test ! -f "$AGENT"; then
+		echo "ERROR: '$AGENT' not found, exiting"
+		quit 1
+	elif test ! -x "$AGENT"; then
+		# Could try chmod but dont know what we will be
+		# chmoding so just fail.
+		echo "ERROR: '$AGENT' not executable, exiting"
+		quit 1
+	fi
+
+	CMD="perl $AGENT"
+}
+
+syntax () {
+	# Prints script syntax
+
+	echo "Syntax:"
+	echo "$0"
+}
+
+checkDepends() {
+	CURL=`which curl 2>/dev/null`
+	if test "$?" -gt 0; then
+		echo "WARNING: Failed to locate curl binary."
+	else
+		echo "INFO: Located curl: $CURL"
+	fi
+	UNZIP=`which unzip 2>/dev/null`
+	if test "$?" -gt 0; then
+		echo "WARNING: Failed to locate unzip binary."
+	else
+		echo "INFO: Located unzip: $UNZIP"
+	fi
+}
+
+update() {
+	# Run the update
+	if test -n "$AUTO_UPDATE"; then
+		if [ -z "$CURL" -o -z "$UNZIP" ]; then
+			checkDepends
+		fi
+		if [ -f "$CURL" -a -x "$CURL" ] && [ -f "$UNZIP" -a -x "$UNZIP" ]; then
+			CURRENT=$(cat $AGENTDIR/Cfg/Config.pm | grep version | grep -oh [0-9]*)
+			REVISION=$(curl -s http://svn.code.sf.net/p/hldstart/code/trunk/ | grep "<h2>" | awk '{print $4}' | tr -d [:punct:])
+			if [ "$CURRENT" == "$REVISION" ]; then
+				echo "The agent is up to date."
+			else
+				URL=http://${MIRROR}.dl.sourceforge.net/project/ogpextras/Alternative-Snapshot/linux-agent-${REVISION}.zip
+				HEAD=$(curl -Os --head -w "%{http_code}" "$URL")
+				if [ "$HEAD" == "200" ]; then
+					echo "Updating server using curl."
+					curl -Os $URL
+					unzip -q linux-agent-${REVISION}.zip
+					sed -i "s/version.*/version => 'v${REVISION}',/" $AGENTDIR/Cfg/Config.pm
+					if test $? -ne 0; then
+						echo "`date`: Wget update failed, ignoring."
+						return 0
+					fi
+					cd linux-agent-${REVISION}
+					cp -avf Crypt File Frontier KKrcon ogp_agent.pl ogp_screenrc ogp_agent_run $AGENTDIR &> /dev/null
+					if test ! -e "$AGENTDIR/IspConfig"; then
+						cp -avf IspConfig $AGENTDIR &> /dev/null
+					else
+						cp -avf IspConfig/sites_ftp_user_* $AGENTDIR/IspConfig &> /dev/null
+					fi
+					if test ! -e "$AGENTDIR/Cfg/Preferences.pm"; then
+						cd Cfg
+						cp -avf Preferences.pm $AGENTDIR/Cfg &> /dev/null
+						cd ..
+					fi
+					cd ..
+					rm -Rf linux-agent-${REVISION} &> /dev/null
+					chmod +x $AGENTDIR/ogp_agent.pl &> /dev/null
+					chmod +x $AGENTDIR/ogp_agent_run &> /dev/null
+				else
+					echo "There is a update available (${REVISION}) but the download source is not ready.";
+					echo "Try again later."
+				fi
+			fi
+		else
+			if [ !-f "$CURL" ]; then
+				echo "WARNING: Could not locate curl binary: ${CURL}."
+			fi
+			if [ !-f "$UNZIP" ]; then
+				echo "WARNING: Could not locate unzip binary: ${UNZIP}."
+			fi
+			echo "Update failed."
+		fi
+	fi
+	
+	return 0
+}
+	
+run() {
+	# Runs the subversion update and server
+	if test -n "$RESTART" ; then
+		echo "Server will auto-restart if there is a crash."
+
+		#loop forever
+		while true
+		do
+			# Update
+			update
+			# Run
+			$CMD
+			retval=$?
+			if test $retval -eq 0 && test -z "$AUTO_UPDATE"; then
+				break; # if 0 is returned then just quit
+			fi
+			echo "`date`: Server restart in $TIMEOUT seconds"
+			# don't thrash the hard disk if the server dies, wait a little
+			sleep $TIMEOUT
+		done # while true
+	else
+		update
+		$CMD
+	fi
+}
+
+quit() {
+	# Exits with the give error code, 1
+	# if none specified.
+	# exit code 2 also prints syntax
+	exitcode="$1"
+
+	# default to failure
+	if test -z "$exitcode"; then
+		exitcode=1
+	fi
+
+	case "$exitcode" in
+	0)
+		echo "`date`: OGP Agent Quit" ;;
+	2)
+		syntax ;;
+	*)
+		echo "`date`: OGP Agent Failed" ;;
+	esac
+
+	# Remove pid file
+	if test -n "$PID_FILE" && test -f "$PID_FILE" ; then
+		# The specified pid file
+		rm -f $PID_FILE
+	fi
+
+	# reset SIGINT and then kill ourselves properly
+	trap - 2
+	kill -2 $$
+}
+
+# Initialise
+init $*
+
+# Run
+run
+
+# Quit normally
+quit 0

+ 8 - 0
ogp_screenrc

@@ -0,0 +1,8 @@
+startup_message off
+hardstatus on
+hardstatus alwayslastline '%{gk}[ %{G}%H %{g}][%= %{wk}%?%-Lw%?%{=b kR}[%{W}%n%f %t%?(%u)%?%{=b kR}]%{= kw}%?%+Lw%?%?%= %{g}][%{Y}%l%{g}]%{=b C}[ %D %m/%d %C%a ]%{W}'
+# Default scroll back 100
+defscrollback 100
+deflog on
+logfile $PWD/screenlogs/screenlog.%t
+