#!/bin/sh
eval 'if [ -x /usr/local/cpanel/3rdparty/bin/perl ]; then exec /usr/local/cpanel/3rdparty/bin/perl -x -- $0 ${1+"$@"}; else exec /usr/bin/perl -x $0 ${1+"$@"}; fi;'
if 0;

#!/usr/bin/perl

BEGIN {
    push(@INC,'/var/cpanel/cpgs/perl');
};

package cPGSLib;

##########################################################################################
#
# cPGSLib : darren@cpanel.net : http://cpgs.cpanel.net/
#
# Library to manipulate server packages and handle various cPGS related duties
#
##########################################################################################

use strict;
use Fcntl qw(:DEFAULT :flock SEEK_END);
use Storable qw(nfreeze thaw);
use IPC::Open2 qw(open2);
use Socket;

##########################################################################################
#######################################[ variables ]######################################
##########################################################################################

my $user               = $ENV{'USER'};
my $origiam            = $user;

our $VERSION        = '0.9.3';
our $SUBVERSION     = '0.0.3';
our $ugs_dir           = '/var/cpanel/cpgs/cfg/ugs';
our $res_dir           = '/var/cpanel/cpgs/cfg/resellers';
our $backend_srvs      = '/var/cpanel/cpgs/cfg/backend_servers';
our $myresellerconf    = '/var/cpanel/gameserv_resellers.cfg';
our $myextmirrors      = '/var/cpanel/gameserv_extmirrors.txt';
our $cpgsconf          = '/var/cpanel/cpgs/cpgsd.cfg';
our $updates_flag_file = '/var/cpanel/cpgs/disable_updates';
our $dbg               = 0;
our $sitetimeout       = 5;

our $defportstable = <<EOF;
<table><th>Default Ports Quick Reference</th>
<tr><td>Left 4 Dead </td><td> 27015</td></tr>
<tr><td>Half Life </td><td> 27015</td></tr>
<tr><td>Half Life <sup>2</sup> </td><td> 27015</td></tr>
<tr><td>GTA: San Andreas </td><td> 7777</td></tr>
<tr><td>Unreal Tournament 2004 </td><td> 7777</td></tr>
<tr><td>Unreal Tournament 3 </td><td> 7777</td></tr>
<tr><td>Call Of Duty </td><td> 28960</td></tr>
<tr><td>Call of Duty 2</td><td> 28960</td></tr>
<tr><td>Call of Duty 4</td><td> 28960</td></tr>
<tr><td>Jedi Knight: Jedi Academy</td><td>29070</td></tr>
<tr><td>Savage: The Battle For Newerth </td><td> 11235</td></tr>
<tr><td>Return to Castle Wolfenstein (ET) </td><td> 27960</td></tr>
<tr><td>Enemy Territory: Quake Wars </td><td> 27733</td></tr>
<tr><td>Battlefield 1942 </td><td> 23000</td></tr>
<tr><td>Battlefield 2142 </td><td> 16567</td></tr>
<tr><td>Battlefield Vietnam </td><td> 23000</td></tr>
<tr><td>Battlefield 2 </td><td> 16567</td></tr>
<tr><td>Americas Army </td><td> 1716</td></tr>
<tr><td>Soldier of Fortune 2 </td><td>20100</td></tr>
<tr><td>Teamspeak </td><td>14534, 51234, 8768</td></tr>
<tr><td>Medal of Honor: Allied Assault</td><td>12203</td></tr>
<tr><td>Battlefield 2</td><td>29900</td></tr></table>
EOF


##########################################################################################
#######################################[ functions ]######################################
##########################################################################################


#######################################[ getpkginfo ]#####################################

sub getpkginfo {
    my ( $arg, $file ) = @_;
    my ( %rep, $data );
    if ( $arg !~ /^(truncate|list)$/ ) { print "Bad argument: \"$arg\"\n"; }

    # untaint $file
    if ( $file =~ /^([-\@\w.\/]+)$/ ) { $file = $1; }
    else                              { print "didn't match \"$file\"..\n"; }

    no strict "subs";

    my %defaults = {
            'status' => 4,
            'name' => 'NA',
            'lines' => 'NA',
            'blocks' => 'NA',
            'size' => 'NA',
            'vers' => 'NA',
            'misc' => 'NA',
            'crtime' => 'NA'
        };

    if ( !-f $file ) {
        print "File \"$file\" not available : $!\n";
        return \%defaults;
    }

    if ( -z $file ) {
        print "File \"$file\" is 0 bytes : $!\n";
        return \%defaults;
    }

    my $pkg_fh;

    if ( $arg eq 'truncate' ) {
        if ( ! sysopen( $pkg_fh, $file, O_RDWR | O_BINARY ) ) {
            $rep{'msg'} = "Could not open file \"$file\" : $!";
            $rep{'retcode'} = 1;
            return \%rep;
        }
    } else {
        if ( ! sysopen( $pkg_fh, $file, O_RDONLY | O_BINARY ) ) {
            $rep{'msg'} = "Could not open file \"$file\" : $!";
            $rep{'retcode'} = 1;
            return \%rep;
        }
    }

    my $pkg_vers;
    my %pkg_info;

    #~ $pkg_info{'pkgformat'} = ( 0|1|2 )
    #~      0 = old style package
    #~      1 = new style package
    #~      2 = bad package format

    my $size = ( stat($file) )[7];
    my $tru = $size - 175;
    sysseek( $pkg_fh, $tru, 0 );
    sysread( $pkg_fh, $data, 175 );

    if ( $data =~ /^name\:([\sa-z0-9\s\-]{15})lines:([\s\d]{14})blocks:([\s\d]{13})size:([\s\d]{15})vers:(.{35})misc:(.{35})time:(.{10})/ ) {
        $pkg_info{'name'}   = $1;
        $pkg_info{'lines'}  = $2;
        $pkg_info{'blocks'} = $3;
        $pkg_info{'size'}   = $4;
        $pkg_info{'vers'}   = $5;
        $pkg_info{'misc'}   = $6;
        $pkg_info{'crtime'} = $7;

        if ( $arg eq 'truncate' ) {
            if ( !flock( $pkg_fh, LOCK_EX ) ) { print "Can't lock filename \"$file\": $!"; }
            truncate( $pkg_fh, $tru );
            flock( $pkg_fh, LOCK_UN );
        }

        $pkg_info{'pkgformat'} = 0;

        $pkg_info{'name'}   = stripvalue($pkg_info{'name'});
        $pkg_info{'lines'}  = stripvalue($pkg_info{'lines'});
        $pkg_info{'blocks'} = stripvalue($pkg_info{'blocks'});
        $pkg_info{'size'}   = stripvalue($pkg_info{'size'});
        $pkg_info{'vers'}   = stripvalue($pkg_info{'vers'});
        $pkg_info{'misc'}   = stripvalue($pkg_info{'misc'});
        $pkg_info{'crtime'} = stripvalue($pkg_info{'crtime'});

    } else {
        # new style with dynamic size
        my $dyn  = $size - 15;
        my $dyn_start;
        sysseek( $pkg_fh, $dyn, 0 ) or die "Could not seek to beginning of file: $!\n";
        sysread( $pkg_fh, $dyn_start, 15 ) or die "Could not read last 15 bytes of file: $!\n"; # read in what we expect to be the dynamic seek info
        # $dyn_start = 'DYNSK0000000175'; # this is the format, tagged DYNSK and followed by 10 digits that represent the number of bytes to go back. 10 digits gives us about 9.3GB of header data possible, plenty for the forseeable future.
        if($dyn_start =~ m/^DYNSK(\d+)$/) {
            my $tru = int($1);
            my $hdr_start = $size - $tru - 15;
            sysseek( $pkg_fh, $hdr_start, 0);
            sysread( $pkg_fh, $data, $tru);

            my $var = '';

            foreach my $chr(split(//,$data)) {
                $var .= $chr;
                if($var =~ m/^HDR\(([\w\d\s\-]+),(.*)\)$/) { # get the name of the data and read it in to a new hash key/value
                    $pkg_info{$1} = $2;
                    $var = '';
                }
            }

            if ( $arg eq 'truncate' ) {
                if ( !flock( $pkg_fh, LOCK_EX ) ) { print "Can't lock filename \"$file\": $!"; }
                truncate( $pkg_fh, $hdr_start );
                flock( $pkg_fh, LOCK_UN );
            }
            $pkg_info{'pkgformat'} = 1;

        } else { # if we don't find the static data or the dynamic pointer, assume it's a bunk file and just report back some non-info

            my (@junk) = split( /\//, $file );
            my $fin = pop(@junk);
            $fin =~ s/\.cpgs$//i;
            $pkg_info{'pkgformat'} = 2;
            $pkg_info{'name'}   = $fin;
            $pkg_info{'lines'}  = 'NA';
            $pkg_info{'blocks'} = 'NA';
            $pkg_info{'size'}   = 'NA';
            $pkg_info{'vers'}   = 'NA';
            $pkg_info{'misc'}   = 'NA';
            $pkg_info{'crtime'} = 'NA';
        }
    }

    close($pkg_fh);
    return( \%pkg_info );
}

#######################################[ buildpkg ]#######################################

sub buildpkg {
    my $data_ref = shift;

    my ( %rep, $tar, $blockofnuls, $cblock, $cfile, $lines );

    # mandatory data:
    #   itag    - short name of game server such as 'cstrike' or 'ts3'
    #   name    - long name of game server such as 'Counter Strike' or 'Teamspeak 3'
    #   vers    - version of the game server package
    #   gdir    - full path to directory to build package from, such as /home/user/cstrike_maps_maniadmin/
    #   file    - path/filename of resulting package file

    # optional data:
    #   arch    - 32 or 64 for 32bit/64bit binary files
    #   os      - Operating System the package is for, linux, bsd, win (although Windows is in no way supported right now)
    #   desc    - long-ish description of what is in the package, changes made, etc
    #   note    - short description of the package, ideally ~5 or so words
    #   cr_mail - contact email address of the package creator
    #   cr_name - name of person or company/organization that created the package
    #   infourl - URL to website, forum thread, whatever with any extra info related to the package (or just to give credit)
    #   pre     - file name of script to run before extracting package files
    #   post    - file name of script to run after extracting package files

    # Other data may be added if you'd like for internal uses, but will be ignored by cPGS.

    if ( ! $$data_ref{'itag'} or $$data_ref{'itag'} !~ /^[a-z0-9]+$/ ) {
        $rep{'msg'} = 'Invalid itag "' . $$data_ref{'itag'} . '". Please only use numbers and lowercase letters';
        $rep{'retcode'} = 1;
        return (\%rep);
    }

    if ( ! $$data_ref{'name'} or $$data_ref{'name'} !~ /^[\w\d\ \-\:]+$/ ) {
        $rep{'msg'} = 'Invalid name "' . $$data_ref{'name'} . '". Please only use regular characters such as letters, numbers, spaces, underscores or dashes';
        $rep{'retcode'} = 1;
        return (\%rep);
    }

    $$data_ref{'gdir'} =~ s/\/+/\//g;
    $$data_ref{'gdir'} =~ s/\/$//g;

    if ( ! $$data_ref{'gdir'} or ! -d $$data_ref{'gdir'} ) {
        $rep{'msg'} = 'Invalid directory "' . $$data_ref{'gdir'} . "\" : $!";
        $rep{'retcode'} = 1;
        return (\%rep);
    }

    if ( ! $$data_ref{'vers'} or $$data_ref{'vers'} !~ /^[\w\d\ \-\.]+$/ ) {
        $rep{'msg'} = 'Invalid vers "' . $$data_ref{'vers'} . '". Please only use regular characters such as letters, numbers, spaces, periods, underscores or dashes';
        $rep{'retcode'} = 1;
        return (\%rep);
    }

    $$data_ref{'file'} =~ s/\/+/\//g;
    $$data_ref{'file'} =~ s/\/$//g;

    if ( ! $$data_ref{'file'} or $$data_ref{'file'} !~ /^[\w\d\ \-\.\/]+$/ ) {
        $rep{'msg'} = 'Invalid output file "' . $$data_ref{'file'} . '". Please only use regular characters such as letters, numbers, spaces, periods, underscores or dashes';
        $rep{'retcode'} = 1;
        return (\%rep);
    }

    # prevent some obvious shenanigans

    my @baddirs = ( '/',
                    '/etc',
                    '/usr',
                    '/root',
                    '/var',
                    '/dev',
                    '/tmp',
                    '/home',
                    '/proc',
                    '/sbin',
                    '/bin',
                    '/sys',
                    );

    foreach my $baddir(@baddirs) {
        if( $$data_ref{'gdir'} eq $baddir ) {
            $rep{'msg'} = 'Invalid directory "' . $$data_ref{'gdir'} . "\" : $!";
            $rep{'retcode'} = 1;
            return (\%rep);
        }
    }

    my ($pre,$enc_pre,$post,$enc_post);

    if ( $$data_ref{'pre'} ) {
        if ( -f $$data_ref{'pre'} ) {
            if( open( my $pre_fh,'<',$$data_ref{'pre'} ) ) {
                while(<$pre_fh>) {
                    $pre .= $_;
                }
                close($pre_fh);
            } else {
                $rep{'msg'} = "Pre install/update script given but can't open the file \"" . $$data_ref{'pre'} . "\" : $!";
                $rep{'retcode'} = 1;
                return (\%rep);
            }
        } else {
            $rep{'msg'} = "Pre install/update script given but can't find the file \"" . $$data_ref{'pre'} . "\" : $!";
            $rep{'retcode'} = 1;
            return (\%rep);
        }
        delete $$data_ref{'pre'};
    }

    if( $$data_ref{'post'} ) {
        if ( -f $$data_ref{'post'} ) {
            if( open( my $post_fh,'<',$$data_ref{'post'} ) ) {
                while(<$post_fh>) {
                    $post .= $_;
                }
                close($post_fh);
            } else {
                $rep{'msg'} = "Post install/update script given but can't open the file \"" . $$data_ref{'post'} . "\" : $!";
                $rep{'retcode'} = 1;
                return (\%rep);
            }
        } else {
            $rep{'msg'} = "Post install/update script given but can't find the file \"" . $$data_ref{'post'} . "\" : $!";
            $rep{'retcode'} = 1;
            return (\%rep);
        }
        delete $$data_ref{'post'};
    }

    if($pre) {
        $enc_pre = encode_base64( $pre );
        $enc_pre =~ s/\n/###/g;
    }

    if($post) {
        $enc_post = encode_base64( $post );
        $enc_post =~ s/\n/###/g;
    }

    my $du = 'du';
    if ( $^O =~ /bsd/i ) { $tar = 'gtar'; } else { $tar = 'tar'; }

    my $crtime = time;

    # get size of directory for approximation for install size on other servers.
    # this won't always be the same due to diffs in filesystems, but close enough for a good estimate.

    my $dsize;
    my $dcom = "$du -sb $$data_ref{'gdir'} 2>\&1";
    my $dpid  = open( my $du_fh, "$dcom|" ) || die "Can\'t run $dcom : $!\n";
    while (<$du_fh>) {
        chomp;
        if ( m/^(\d+)/ ) { $dsize = $1; last; }
    }
    close($du_fh);

    if($dsize) { $$data_ref{'dsize'} = $dsize; }

    print "Building tarball from directory.. (this might take a while)\n";

    my $com  = "$tar -Rczvf $$data_ref{'file'} -C $$data_ref{'gdir'} . 2>\&1";
    my $pid  = open( my $tar_fh, "$com|" ) || die "Can\'t run $com : $!\n";
    while (<$tar_fh>) {
        chomp;
        my $line = $_;
        if ( length($line) < 1 ) { next; }
        if ( $line =~ m/^block\s(\d+)\:\s+(.*)$/ ) { $cblock = $1; $cfile = $2; $lines++; }
    }
    close($tar_fh);

    my $size = ( stat($$data_ref{'file'}) )[7];

    if( $size < 1 ) {
        print "Invalid file size of zero for server package : $!\n";
        exit;
    }

    my $pkg_fh;
    sysopen( $pkg_fh, $$data_ref{'file'}, O_RDWR | O_BINARY ) or die "Could not open file.. : $!\n";
    if(! flock( $pkg_fh, LOCK_EX ) ) {
        $rep{'msg'} = "Could not lock file $$data_ref{'file'} : $!";
        $rep{'retcode'} = 1;
    }
    if(! sysseek( $pkg_fh, 0, SEEK_END ) ) {
        $rep{'msg'} = "Could not seek to end of package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }

    # no need for this in the meta data, possible info leak if left in
    delete $$data_ref{'gdir'};
    delete $$data_ref{'file'};

    my $ttl_len = 0;
    foreach my $var(keys %{$data_ref}) {
        my $str = 'HDR(' . $var . ',' . $$data_ref{$var} . ')';
        print "Writing $str to end of package\n";
        my $len = length($str);
        $ttl_len += $len;
        if(! syswrite( $pkg_fh, $str, $len ) ) {
            $rep{'msg'} = "Could not write key $var to package file : $!";
            $rep{'retcode'} = 1;
            return \%rep;
        }
    }
    my $block_hdr = 'HDR(blocks,' . $cblock . ')';
    my $block_len = length($block_hdr);
    if(! syswrite( $pkg_fh, $block_hdr, $block_len ) ) {
        $rep{'msg'} = "Could not write key 'blocks' - $cblock to package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }
    $ttl_len += $block_len;
    my $lines_hdr = 'HDR(lines,' . $lines . ')';
    my $lines_len = length($lines_hdr);
    if(! syswrite( $pkg_fh, $lines_hdr, $lines_len ) ) {
        $rep{'msg'} = "Could not write key 'lines' - $lines to package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }
    $ttl_len += $lines_len;
    my $size_hdr = 'HDR(size,' . $size . ')';
    my $size_len = length($size_hdr);
    if(! syswrite( $pkg_fh, $size_hdr, $size_len ) ) {
        $rep{'msg'} = "Could not write key 'size' - $size to package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }
    $ttl_len += $size_len;
    my $crtime = time;
    my $crtime_hdr = 'HDR(crtime,' . $crtime . ')';
    my $crtime_len = length($crtime_hdr);
    if(! syswrite( $pkg_fh, $crtime_hdr, $crtime_len ) ) {
        $rep{'msg'} = "Could not write key 'crtime' - $crtime to package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }
    $ttl_len += $crtime_len;
    my $dsize_hdr = 'HDR(dsize,' . $dsize . ')';
    my $dsize_len = length($dsize_hdr);
    if(! syswrite( $pkg_fh, $dsize_hdr, $dsize_len ) ) {
        $rep{'msg'} = "Could not write key 'dsize' - $size to package file : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    }
    $ttl_len += $dsize_len;

    if( $enc_pre ) {
        my $pre_hdr = 'HDR(pre,' . $enc_pre . ')';
        my $pre_len = length($pre_hdr);
        if(! syswrite( $pkg_fh, $pre_hdr, $pre_len ) ) {
            $rep{'msg'} = "Could not write pre script to package file : $!";
            $rep{'retcode'} = 1;
            return \%rep;
        }
        $ttl_len += $pre_len;
    }
    if( $enc_post ) {
        my $post_hdr = 'HDR(post,' . $enc_post . ')';
        my $post_len = length($post_hdr);
        if(! syswrite( $pkg_fh, $post_hdr, $post_len ) ) {
            $rep{'msg'} = "Could not write post script to package file : $!";
            $rep{'retcode'} = 1;
            return \%rep;
        }
        $ttl_len += $post_len;
    }

    my $pad_len = 10 - length($ttl_len);
    my $padding = '0' x $pad_len;
    my $fin = 'DYNSK' . $padding . $ttl_len;
    syswrite( $pkg_fh, $fin, length($fin) );
    flock( $pkg_fh, LOCK_UN );
    close($pkg_fh);
    $rep{'retcode'} = 0;
    $rep{'msg'}     =
    return \%rep;

}

#######################################[ extractpkg ]#####################################

sub extractpkg {

    my $data_ref = shift;

    my ( $tar, $file, %rep );

    if( ! -f $$data_ref{'file'} ) {
        $rep{'msg'} = "Could not find file $$data_ref{'file'} : $!";
        $rep{'retcode'} = 1;
        return \%rep;
    } else {
        $file = $$data_ref{'file'};
    }

    $rep{'pkg_ref'} = getpkginfo('list',$file);

    if ( $^O =~ /bsd/i ) { $tar = 'gtar'; } else { $tar = 'tar'; }

    if( $$data_ref{'dest'} ) {
        $$data_ref{'dest'} =~ s/^\.\///g;
        my $parts = my @path = split(/\//,$$data_ref{'dest'});
        my $dir = pop(@path);
        my $topdir = join('/',@path);
        if( $parts < 2 ) {
            $topdir = '.';
            $rep{'relative'} = 1;
        }
        $rep{'topdir'} = $topdir;
        $rep{'dir'} = $dir;
        if( ! -d $topdir && $parts > 1 ) {
            $rep{'msg'} = "Could not find base directory $topdir : $!\n";
            $rep{'retcode'} = 1;
        } else {
            my $file = $$data_ref{'file'};
            if( $file !~ m/^\//) { # if we don't have a full path, assume relevant to current directory
                chomp(my $cwd = `pwd`);
                my $file = $cwd . '/' .  $$data_ref{'file'};
            }
            if(! -f $file ) {
                $rep{'msg'} = "Could not find original package file at $file";
                $rep{'retcode'} = 1;
                return \%rep;
            }
            if( ! -d "$topdir/$dir") {
                mkdir "$topdir/$dir";
            }
            if(chdir("$topdir/$dir")) {
                $rep{'ret'} = system("tar xzf $file 2>/dev/null");
                $rep{'msg'} = "Remember to chown -R user:group $$data_ref{'dest'} if the extracted files are not temporary.\n";
                $rep{'retcode'} = 0;
            } else {
                $rep{'msg'} = "Could not change directory to $topdir/$dir : $!\n";
                $rep{'retcode'} = 1;
            }
        }
    } else {
        $rep{'msg'} = "ERROR: No destination directory given, I don't know where to extract the files to.\n";
        $rep{'retcode'} = 1;
    }

    return \%rep;
}

##########################################################################################
#######################################[ subroutines ]####################################
##########################################################################################

sub stripvalue {
    my $in = "@_";
    $in =~ s/(^\s+)|(\s+$)//;
    $in =~ s/\s+/ /;
    return $in;
}

##########################################################################################
#####################################[ Authentication ]###################################
##########################################################################################

sub getauthkey {
    my ( $user, $what ) = @_;
    my $secretkey = '';
    my ($where,$file,$line) = caller;

    my $dbg = 0;
    my $gg;
    if( $dbg > 0 ) {
        open($gg,">>","/tmp/cpgs.debug");
        print $gg "getauthkey recieved \"$user\" ($what)\n";
    }

    my ( $uid, $gid, $home, $key_path );

    if( $user eq 'cpgs_admin' ) {
        $key_path = '/var/cpanel/cpgs/auth/.cpgs_adminkey';
    } elsif( $user eq 'cpgs_query' ) {
        $key_path = '/var/cpanel/cpgs/auth/.cpgs_querykey';
    } else {
        if(( undef, undef, $uid, $gid, undef, undef, undef, $home, undef, undef ) = getpwnam($user)) {
        } else {
            main::msglog("Could not find local user $user");
            return(1,"Could not find local user $user");
        }
        if( ! $home ) {
            main::msglog("Empty home directory value ( $home ) found for $user : $!");
            return(1,"Empty home directory value ( $home ) found for $user : $!");
        } elsif( ! -d $home ) {
            main::msglog("Home directory for user $user ( $home ) is not really a directory : $!");
            return(1,"Home directory for user $user ( $home ) is not really a directory: $!");
        } else {
            $key_path = $home . '/.cpgskey';
        }
    }

    if( $dbg > 0 ) { print $gg "$user has key_path of $key_path\n"; }

    if ( open( my $key_fh, '<', $key_path ) ) {
        while (<$key_fh>) {
            s/(\r|\n)//g;
            if (m/secret\=(.*)/) {
                $secretkey = $1;
                if( $dbg > 0 ) { print $gg "Got the key : \"$secretkey\" from $key_path \n"; }
                last;
            } else {
                $secretkey = $_;
                if( $dbg > 0 ) { print $gg "Guessing the key is : \"$secretkey\" from $key_path \n"; }
                last;
            }
        }
        close($key_fh);
    }
    else {
        if( $dbg > 0 ) { print $gg "no key file at $key_path , creating one\n"; }
        if ( ! $secretkey ) {
            my @chars = split( /\s+/, "a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 ! @ # $ % ^ & * ( ) _ + - = [ ] { } , < . > / ? ; : ' \"" );
            srand;
            for ( my $i = 0; $i <= 20; $i++ ) {
                my $rand = int( rand 32 );
                $secretkey .= $chars[$rand];
            }
        }
        my $pid;
        unless ( $pid = fork ) {
            my $umask = umask(0027);
            if( $user ne 'cpgs_admin' and $user ne 'cpgs_query' ) {
                $( = $gid;
                $) = $gid;
                $< = $uid;
                $> = $uid;
            }
            if ( open( my $key_fh, '>', $key_path ) ) {
                print $key_fh "secret=$secretkey\n";
                close($key_fh);
                if( $dbg > 0 ) { print $gg "wrote new key for $user to $key_path\n"; }
            }
            else {
                main::msglog("Could not write to $key_path : $!");
            }
            umask($umask);
            exit(0);
        }
        waitpid( $pid, 0 );
    }
    if( $dbg > 0 ) {
        print $gg "DONE\n\n";
        close($gg);
    }
    return ( 0, $secretkey );
}


##########################################################################################
#####################################[ Communication ]####################################
##########################################################################################

sub sendssl {
    my ( $meta, $data ) = @_;
    my $reply;
    my $ipval;

    if ( $$meta{'remip'} && $$meta{'remip'} =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ ) {
        $$meta{'remip'} =~ s/(\r|\n)//g;
    }
    else {
        if ( defined( $$meta{'user'} ) && defined( $$meta{'game'} ) && defined( $$meta{'srvn'} ) ) {
            $$meta{'remip'} = getremip( $$meta{'user'}, $$meta{'game'}, $$meta{'srvn'} );
            if( ! $$meta{'remuser'} ) { $$meta{'remuser'} = getremuser( $$meta{'user'}, $$meta{'game'}, $$meta{'srvn'} ); }
        }
        else {
            print $$meta{'command'} . " :: Did not get remip or the user, game and srvn to determine it with, please check configuration in WHM.\n";
            exit;
        }
    }

    if ( $$meta{'command'} ) {
        if ( $dbg > 0 ) {
            print "command will be " . $$meta{'command'} . " to IP " . $$meta{'remip'} . " <br>\n";
        }
    }
    else {
        if ( $dbg > 0 ) {
            print "unknown command @_ <br>\n";
        }
    }

    if ( $dbg > 0 ) {

        #use Data::Dumper;
        print "<br><<|||||||||| META<br><pre>\n";

        #print Dumper($meta);
        print "</pre>)))))))))))) END OF META<br>\n<br><<|||||||||| DATA<br><pre>\n";

        #print Dumper($data);
        print "</pre>)))))))))))) END OF DATA<br>\n";
    }
    my $meta_ser = encode_base64( nfreeze \%{$meta} );
    my $data_ser = encode_base64( nfreeze \%{$data} );
    $meta_ser =~ s/\n/\#\#\#/g;
    $data_ser =~ s/\n/\#\#\#/g;

    my $pid = open2( \*SSLREAD, \*SSLWRITE, '/var/cpanel/cpgs/cpgs_comm', $meta_ser, $data_ser );
    if ( $dbg > 0 ) {
        print "PID of comm process is $pid <br>\n";
    }
    close(SSLWRITE);
    while (<SSLREAD>) {
        if ( $dbg > 0 ) { print "Getting back $_ <br>\n"; }
        $reply .= $_;
    }
    close(SSLREAD);
    if ( $dbg > 0 ) {
        print "RAW REPLY<br><pre>\n";

        #print Dumper($reply);
        print "</pre> /RAW<br>\n";
    }
    if ( my $rep_ser = decode_base64($reply) ) {
        if ( my %rep = %{ thaw($rep_ser) } ) {
            if ( $dbg > 0 ) {
                print "<br>>>>>>>>>>>>>>>> dumping reply here <br><pre>\n";
                #print Dumper(%rep);
                print "</pre><br>\n<<<<<<<<<<<<<<<< dumped reply there <br>\n";
            }

            my $what     = \%rep;
            my $rep_type = ref($what);
            if ( $rep_type eq 'HASH' ) {
                if ( $dbg > 0 ) {
                    foreach my $kk ( keys %rep ) {
                        print "$kk = $rep{$kk} <br>\n";
                    }
                }
                return ( \%rep );
            }
            elsif ( $rep_type eq 'SCALAR' ) {
                my %newrep;
                print "Reply was a SCALAR? (%rep) <br>\n";
                $newrep{'retmsg'}  = "%rep";
                $newrep{'errmsg'}  = "bad return type ($rep_type) for %rep";
                $newrep{'retcode'} = 10;
                %rep               = %newrep;
            }
            else {
                my %newrep;
                print "Not a hash or scalar, it is a \"$rep_type\" .. (%rep)<br>\n";
                $newrep{'retmsg'}  = "%rep";
                $newrep{'errmsg'}  = "bad return type ($rep_type) for %rep";
                $newrep{'retcode'} = 10;
                %rep               = %newrep;
            }

        }
        else {
            print "Could not thaw returned data : $!<br>\n";
            if ( $dbg > 0 ) {
                print "<br>>>>>>>>>>>>>>>> dumping bad reply here <br><pre>\n";
                #print Dumper($rep_ser);
                print "</pre><br>\n<<<<<<<<<<<<<<<< dumped reply there <br>\n";
            }
        }
    }
    else {
        print "Could not decode returned data : $! ($reply)<br>\n" if $reply;
        if ( $dbg > 0 ) {
            print "<br>>>>>>>>>>>>>>>> dumping bad return data here <br><pre>\n";
            #print Dumper($reply);
            print "</pre><br>\n<<<<<<<<<<<<<<<< dumped bad return data there <br>\n";
        }
    }
}

##########################################################################################
###########################[ Common functions ]###########################################
##########################################################################################

sub loadGameModule {
    my ($game) = @_;
    my %loaded_games;

    if ( -f '/var/cpanel/cpgs/games/' . $game . '/' . $game . '.pm' ) {
        eval "use ${game}::${game}";
        if ($@) {
            print "Could not load module from \"/var/cpanel/cpgs/games/$game/$game\.pm\"\n$@\n";
        }
        else {
            if ( ref( "cPGS::$game"->can('register_self') ) ) {
                ( undef, $loaded_games{'$game'}{'pkg'}, $loaded_games{$game}{'name'}, $loaded_games{$game}{'version'}, $loaded_games{$game}{'descr'} ) = "cPGS::$game"->register_self;
                return ( \%loaded_games );
            }
        }
    }
}

sub save_ini {
    my( $data_ref, $ini_path ) = @_;
    if( -e && ! -w $ini_path ) {
        return 0;
    }
    if( open (my $ini_fh, '>', $ini_path) ) {
        foreach my $section(sort keys %{$data_ref}) {
            print {$ini_fh} "\[$section\]\n";
            foreach my $var(sort keys %{$$data_ref{$section}}) {
                print {$ini_fh} $var . " = " . $$data_ref{$section}{$var} . "\n";
            }
            print {$ini_fh} "\n";
        }
        close($ini_fh);
        return 1;
    } else {
        return 0;
    }

}

sub load_ini {
    my ( $ini_path ) = @_;
    if( ! -r $ini_path ) {
        return 0;
    }
    if( open (my $ini_fh, '<', $ini_path) ) {
        my %data;
        my $section;
        while(<$ini_fh>) {
            chomp;
            if(m/^\[(.+)\]$/) {
                $section = $1;
            }
            elsif(m/^(.*)\s+\=\s+(.*)$/) {
                $data{$section}{$1} = $2;
            }
        }
        close($ini_fh);
        return \%data;
    } else {
        return 0;
    }
}

sub get_ugs_ref {
    my ( $user, $game, $srvn ) = @_;
    my $user_cfg;
    my $cfg_file = $ugs_dir . '/' . $user . '_' . $game . '_' . $srvn . '.ini';
    if( ! -e $cfg_file ) {
        $$user_cfg{'retcode'} = 1;
        $$user_cfg{'errmsg'}  = "Config file $cfg_file for $user, $game # $srvn does not exist, please ensure it has been configured.";
        return $user_cfg;
    } elsif( $user_cfg = load_ini( $cfg_file ) ) {
        $$user_cfg{'retcode'} = 0;
    } else {
        $$user_cfg{'retcode'} = 1;
        $$user_cfg{'errmsg'}  = "Could not retrieve confg data from " . $cfg_file . " : $!";
    }
    return $user_cfg;
}

sub getremuser {
    my ( $user, $game, $srvn ) = @_;
    my $ugs_ref = get_ugs_ref( $user, $game, $srvn );
    my $remuser = $$ugs_ref{'general'}{'remuser'};
    if ( !$remuser ) { $remuser = $user; }
    return ($remuser);
}

sub getremip {
    my ( $user, $game, $srvn, $err ) = @_;
    my $ugs_ref = get_ugs_ref( $user, $game, $srvn );
    if( $$ugs_ref{'retcode'} > 0 ) {
        # we've got an error
        print "Error: $$ugs_ref{'errmsg'}<br>\n";
        exit;
    }
    my $ipval = $$ugs_ref{'general'}{'remip'};

    if ( ( length($ipval) < 7 ) || ( $ipval !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ ) ) {
        if ( $err == 0 ) {
            my ( $pkg, $calling_file, $calling_line ) = caller;
            print "Core Config not yet set for \"$user\" + \"$game\" install # $srvn. <br>Please <a href=\"addon_gs.cgi\?a=coreconfig\&user=$user\&game=$game\&srvn=$srvn\">set the Core Config</a> to the IP of the server";
            print " the cPGS frontend will use when controlling the cPGSD daemon.<br> This must be done for each user + game install.<br>\n";    # ($pkg,$calling_file,$calling_line)<br>\n";
            undef $ipval;
            exit(0);
        }
    }
    return $ipval;
}

sub get_cfg_info {
    my $game = shift;
    my $mod_ref;
    if ( !defined( $mod_ref->{$game}->{'name'} ) ) {
        $mod_ref = loadGameModule($game);
    }
    my $cfg_info;
    if ( ref( "cPGS::$game"->can('getCfgInfo') ) ) {
        ( $cfg_info ) = "cPGS::$game"->getCfgInfo;
        return ( $cfg_info );
    } else {
        return 0;
    }
}

sub get_default_cfg {
    my $game = shift;
    my $mod_ref;
    if ( !defined( $mod_ref->{$game}->{'name'} ) ) {
        $mod_ref = loadGameModule($game);
    }
    my $default_cfg_ref;
    if ( ref( "cPGS::$game"->can('getCfgDefaults') ) ) {
        ( $default_cfg_ref ) = "cPGS::$game"->getCfgDefaults;
        return ( $default_cfg_ref );
    } else {
        return 0;
    }
}

# base64 functions taken directly from MIME::Base64::Perl

sub encode_base64 ($;$) {
    if ( $] >= 5.006 ) {
        require bytes;
        if ( bytes::length( $_[0] ) > length( $_[0] ) || ( $] >= 5.008 && $_[0] =~ /[^\0-\xFF]/ ) ) {
            require Carp;
            Carp::croak("The Base64 encoding is only defined for bytes");
        }
    }

    use integer;

    my $eol = $_[1];
    $eol = "\n" unless defined $eol;

    my $res = pack( "u", $_[0] );

    # Remove first character of each line, remove newlines
    $res =~ s/^.//mg;
    $res =~ s/\n//g;

    $res =~ tr|` -_|AA-Za-z0-9+/|;    # `# help emacs
                                      # fix padding at the end
    my $padding = ( 3 - length( $_[0] ) % 3 ) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

    # break encoded string into lines of no more than 76 characters each
    if ( length $eol ) {
        $res =~ s/(.{1,76})/$1$eol/g;
    }
    return $res;
}

sub decode_base64 ($) {
    local ($^W) = 0;                  # unpack("u",...) gives bogus warning in 5.00[123]
    use integer;

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;      # remove non-base64 chars
    if ( length($str) % 4 ) {

        # Length of base64 data not a multiple of 4
        # print "Encoded data ($str) is apparently corrupt, see /var/log/cpgsd.log for more details";
    }
    $str =~ s/=+$//;                  # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;      # convert to uuencoded format
    return "" unless length $str;

    ## I guess this could be written as
    #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
    #           $str =~ /(.{1,60})/gs) ) );
    ## but I do not like that...
    my $uustr = '';
    my ( $i, $l );
    $l = length($str) - 60;
    for ( $i = 0; $i <= $l; $i += 60 ) {
        $uustr .= "M" . substr( $str, $i, 60 );
    }
    $str = substr( $str, $i );

    # and any leftover chars
    if ( $str ne "" ) {
        $uustr .= chr( 32 + length($str) * 3 / 4 ) . $str;
    }
    return unpack( "u", $uustr );
}

sub get_cfg_value {
    my $search_var = shift;
    if(open(my $cfg_fh,'<','/var/cpanel/cpgs/cpgsd.cfg')) {
        while(<$cfg_fh>) {
            my($var,$val) = split(/\=/,$_,2);
            if($var eq $search_var) {
                return($val);
                last;
            }
        }
        close($cfg_fh);
    }
    return;
}

sub get_rand_string {
    my ($length) = @_;
    my @chars = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 );
    my $return;
    foreach ( 1 .. $length ) {
        $return .= $chars[ rand(@chars) ];
    }
    return $return;
}

# Change this call to accept a hash ref of args instead of list
sub steamupdate {
    my ( $args_ref ) = @_;
    my $user = $args_ref->{'user'};
    my $game = $args_ref->{'game'};
    my $srvn = $args_ref->{'srvn'};
    my $short = $args_ref->{'short'};
    my $long = $args_ref->{'long'};
    my $gameid = $args_ref->{'gameid'};
    my $use_steamcmd = $args_ref->{'use_steamcmd'} || 0;

    no strict "subs";
    my $steam_up_retry = 0;

  STEAMUP:
    if ( $steam_up_retry > 3 ) {
        main::msglog("Steam update appears to be caught in a loop, aborting.");
        return ('loop');
    }
    main::msglog("steam update for $user, $game, $srvn, $short, $long");
    setsid or main::msglog("ERROR: Can't start a new session: $! ");
    my ( undef, undef, $uid, $gid, undef, undef, undef, $home, undef, undef ) = getpwnam($user);
    my $game_base_dir = "$home/.gameservers/$short\_$srvn";
    if ( open( my $steam_run_fh, '<', "$game_base_dir/.steam_is_running" ) ) {
        my $steam_pid = (<$steam_run_fh>);
        close($steam_run_fh);
        main::msglog("Checking to see if $steam_pid is still running..");
        if ( kill 0, $steam_pid ) {
            main::msglog("Steam update already running for $user, $game, $srvn [$steam_pid] , aborting server startup.");

            # when able, show current status of steam update, similar to install status
            return ("running=$steam_pid");
        }
        else {
            main::msglog("No steam update found running..");
        }
    }
    main::msglog("Starting steam update forking process");

    my $steamppid;
    my $steamppid2;
    my $restart_after_exit = 0;
    my ( $worker, $boss );
    socketpair( $worker, $boss, AF_UNIX, SOCK_STREAM, PF_UNSPEC ) || main::msglog("Could not create socket pair: $!");

    if ( $steamppid = fork ) {
        close($boss);
        my $slavepid2;
        while (my $line = <$worker>) {
            chomp($line);
            main::msglog("read from child: $line");
            if( $line =~ m/^SLAVEPID=(\d+)$/ ) {
                $slavepid2 = $1;
            }
            elsif( $line =~ m/^UPPID=(\d+)$/ ) {
                $steamppid2 = $1;
            }
            elsif ( $line =~ m/restart_steam_update/ ) {
                $restart_after_exit = 1;
                close($worker);
                last;
            }
            elsif ( $line =~ m/goodbye/ ) {
                close($worker);
            }
        }
        close($worker) if $worker;
        main::msglog( "boss leaving, letting double forked slave child do it's thing.." );
        # main::msglog("parent waiting on $slavepid2 , $steamppid vs $steamppid2");
        # waitpid( $slavepid2, 0 );
    }
    else {
        close($worker);
        my $slavepid;
        unless ($slavepid = fork) {
            print $boss "SLAVEPID=$$\n";

            $0 = "$main::dname/$cPGSLib::VERSION\-$cPGSLib::SUBVERSION Updating $game #$srvn for $user";
            $) = "$gid $gid";
            $( = "$gid $gid";
            $> = $uid;
            $< = $uid;

            if ( $< != $uid || $( != $gid ) {
                main::msglog("Failed to drop privileges to $uid:$gid");
                main::shutdown();
            }

            my $logfile_path = $home . '/.gameservers/' . $short . '_' . $srvn . '/' . $short . '.log';
            unlink($logfile_path) if -f $logfile_path;

            if( ! chdir($game_base_dir) ) {
                main::msglog( "Steam update failed. Could not chdir to $game_base_dir : $!" );
                return;
            }
            my $va = '';

            my $steam_binary = '';
            if( $use_steamcmd == 1 ) {
                $steam_binary = "$game_base_dir/linux32/steamcmd";
            } else {
                $steam_binary = "$game_base_dir/steam";

                if ( !-x $steam_binary ) {
                    $steam_binary = "$game_base_dir/$short/steam";
                }
            }
            if ( -x $steam_binary ) {

              # disabling --verify_all to prevent overwriting motd.txt and others
              # msglog("Autoupdate enabled, running \"$home/.gameservers/$short\_$srvn/steam -command update -game \"$gameid\" -dir . -verify_all\"");
              # my $pid = open(my $steam_fh, "$home/.gameservers/$short\_$srvn/steam -command update -game \"$gameid\" -dir . -verify_all |");

                my $log_fh;
                my $logit = 1;
                my $logfile = "$game_base_dir/$short\.log";

                if(!open($log_fh,'>>',$logfile)) {
                    main::msglog("Could not open $logfile for steam update logging.");
                    $logit = 0;
                }

                my $infofile = "$home/.gameservers/.install\_$game\_$srvn";

                $ENV{'LD_LIBRARY_PATH'} = $ENV{'LD_LIBRARY_PATH'} . ":" . $args_ref->{'lib_path'};

                my $update_cmd_line = '';
                if( $use_steamcmd == 1 ) {
                    $update_cmd_line = "$steam_binary $args_ref->{'steamcmd_args'}";
                } else {
                    $update_cmd_line = "$steam_binary -command update -game \"$gameid\" -dir . $va";
                }

                main::msglog("Autoupdate enabled, running \"$update_cmd_line\"");
                my $pid = open( my $steam_fh, "$update_cmd_line |" );
                main::msglog("Steam update PID: $pid");
                print $boss "UPPID=$pid\n";
                if( open( my $steam_run_fh, '>', "$game_base_dir/.steam_is_running" ) ) {
                    print ${steam_run_fh} $pid;
                    close($steam_run_fh);
                } else {
                    main::msglog("Could not write to $game_base_dir/.steam_is_running : $!");
                }
                select($steam_fh);
                $| = 1;

                while (my $line = <$steam_fh>) {
                    $line =~ s/(\r|\n)//g;
                    $line =~ s/^\[0m\[1m//;
                    if ($line) {
                        main::msglog("STEAM SAYS: $line");
                        if ( $line =~ m/Steam Linux Client updated, please retry the command/) { $steam_up_retry++; $restart_after_exit = 1; main::msglog("Steam client update detected"); }
                        elsif ( $line =~ m/Getting version (\d+)/) { $steam_up_retry++; $restart_after_exit = 1; main::msglog("Detected steam binary update, setting flag to restart steam update once done."); }
                        elsif ( $line =~ m/Update complete\,.launching Steam/) { $steam_up_retry++; $restart_after_exit = 1; main::msglog("Detected steamcmd update, setting flag to restart steam update once done."); }
                        elsif ( $line =~ m/^ERROR\!.*not online or not logged in to Steam/) { main::msglog("Detected Steam failure, try operation again or updating Steam user/pass if needed."); }
                        if(open(my $info_fh,'>',$infofile)) {
                            print ${info_fh} "Notice(\"Updating: $line\")\n" or main::msglog("Could not write to installer info file.. ? : $!");
                            close($info_fh);
                        }
                    }
                }
                main::msglog("Steam update has closed");
                close($steam_fh);
                close($log_fh);
            }
            else {
                main::msglog("Could not find steam binary at $steam_binary");
            }
            if ( $restart_after_exit == 1 ) {
                print $boss "restart_steam_update\n";
            }
            print $boss "goodbye\n";
            close($boss);
            exit(0);
        }
        # waitpid( $slavepid, 0 );
        # main::msglog("------- could wait on slave pid $slavepid here..");
        exit(0);
    }
    main::msglog("waiting on $steamppid");
    waitpid( $steamppid, 0 );
    unlink("$home/.gameservers/$short\_$srvn/.steam_is_running");
    if ( $restart_after_exit == 1 ) {
        if( $dbg > 0 ) { main::msglog("Restarting Steam update.."); }
        goto STEAMUP;
    }
    main::msglog("Steam update completed.");
    return;
}


__END__

=pod

=head1 NAME

    cPGSLib

=head1 DESCRIPTION

    Library to manipulate server packages and handle various cPGS related duties

=head1 USAGE

    use cPGSLib;

    getpkginfo();
    buildpkg();
    extractpkg();
    sendssl();

=head1 USAGE EXAMPLES


=over 4

=item B<getpkginfo(arg,file);>

arg = truncate | list

"truncate" will return the data and strip it from $file

"list" will just return the data but leave $file untouched

file = file to perform arg on

example: my $pkg_ref = getpkginfo("list","halflife.cpgs");

        Then you can check pkgformat value, 0 = old style package, 1 = new style, 2 = bad package file (couldn't parse cPGS data)

        $$pkg_ref{'pkgformat'};

        If pkgformat is 0, the following are guaranteed:

        $$pkg_ref{'name'};
        $$pkg_ref{'lines'};
        $$pkg_ref{'blocks'};
        $$pkg_ref{'size'};
        $$pkg_ref{'vers'};
        $$pkg_ref{'misc'};
        $$pkg_ref{'crtime'};

        If the pkgformat is 1, the following are guaranteed:

        $$pkg_ref{'itag'};
        $$pkg_ref{'name'};
        $$pkg_ref{'lines'};
        $$pkg_ref{'blocks'};
        $$pkg_ref{'size'};
        $$pkg_ref{'vers'};
        $$pkg_ref{'crtime'};

          Optionally:

          $$pkg_ref{'arch'};
          $$pkg_ref{'os'};
          $$pkg_ref{'desc'};
          $$pkg_ref{'note'};
          $$pkg_ref{'fmail'};
          $$pkg_ref{'fname'};
          $$pkg_ref{'infourl'};


        * $$pkg_ref{'gdir'} and $$pkg_ref{'file'} are explicitly removed from package meta data output


=item B<extractpkg(file);>

Return the package data from $file if present and extract the contents

example: my $hash_ref = extractpkg("halflife.cpgs");
         print "Return status on extracting package was $$hash_ref{'ret'} \n";

=item B<buildpkg(file,name,version,misc);>

Takes $file and builds in the name and other meta data
"name" is mandatory
"version" and "misc" are optional

example: buildpkg("halflife.cpgs","hlds","1.6","Updated 12/21/2006");
E<nbsp>

=item B<sendssl(\%meta,\%data)>

Processes communication request to cPGSD based on the data in %meta.

Required values in %meta:
    $meta{'command'}   - The command for cPGSD to perform
    $meta{'remip'}     - The IP where cPGSD is expected to be listening on
    $meta{'remuser'}   - The user cPGSD should process the command as

Optional values for %meta:
    $meta{'user'}      - The user a request pertains to, often the same as $meta{'remuser'}
    $meta{'game'}      - The game a request pertains to
    $meta{'srvn'}      - The install # of a server a request pertains to
    $meta{'____'}      - Where ____ is any other key needed for a specific call, you can add
                         as many as you want depending on the needs of the call.

Values for the %data hash are dependant on each specific call. Many requests for information
to cPGSD have empty %data hashes.

example:
    sub GameServer_getuptime {
        my($ipval,$pid)=@_;
        my %meta;
        my %data;
        $meta{'remip'} = $ipval;
        $meta{'command'} = 'getpiduptime';
        $meta{'remuser'} = 'cpgs_query';
        $data{'pid'} = $pid;
        my $rp = cPGSLib::sendssl(\%meta,\%data);
        if($$rp{'retcode'} == 0) {
            return $$rp{'uptime'};
        } else {
            return $$rp{'errmsg'};
        }
    }

=back

=cut

1;