Guest User

Untitled

a guest
Mar 19th, 2017
129
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 91.21 KB | None | 0 0
  1. #!/usr/bin/perl
  2. #
  3. # OGP - Open Game Panel
  4. # Copyright (C) 2008 - 2014 The OGP Development Team
  5. #
  6. # http://www.opengamepanel.org/
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  21. #
  22.  
  23. use warnings;
  24. use strict;
  25.  
  26. use Cwd; # Fast way to get the current directory
  27. use lib getcwd();
  28. use Frontier::Daemon::Forking; # Forking XML-RPC server
  29. use File::Copy; # Simple file copy functions
  30. use File::Copy::Recursive
  31. qw(fcopy rcopy dircopy fmove rmove dirmove pathempty pathrmdir)
  32. ; # Used to copy whole directories
  33. use Crypt::XXTEA; # Encryption between webpages and agent.
  34. use Cfg::Config; # Config file
  35. use Cfg::Preferences; # Preferences file
  36. use Fcntl ':flock'; # Import LOCK_* constants for file locking
  37. use LWP::UserAgent; # Used for fetching URLs
  38. use MIME::Base64; # Used to ensure data travelling right through the network.
  39. use Getopt::Long; # Used for command line params.
  40. use Path::Class::File; # Used to handle files and directories.
  41. use File::Path qw(mkpath);
  42. use Archive::Extract; # Used to handle archived files.
  43. use File::Find;
  44. use Schedule::Cron; # Used for scheduling tasks
  45.  
  46. # Compression tools
  47. use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error); # Used to compress files to bz2.
  48. use Archive::Tar; # Used to create tar, tgz or tbz archives.
  49. use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); # Used to create zip archives.
  50.  
  51. # Current location of the agent.
  52. use constant AGENT_RUN_DIR => getcwd();
  53.  
  54. # Load our config file values
  55. use constant AGENT_KEY => $Cfg::Config{key};
  56. use constant AGENT_IP => $Cfg::Config{listen_ip};
  57. use constant AGENT_LOG_FILE => $Cfg::Config{logfile};
  58. use constant AGENT_PORT => $Cfg::Config{listen_port};
  59. use constant AGENT_VERSION => $Cfg::Config{version};
  60. use constant SCREEN_LOG_LOCAL => $Cfg::Preferences{screen_log_local};
  61. use constant DELETE_LOGS_AFTER => $Cfg::Preferences{delete_logs_after};
  62. use constant AGENT_PID_FILE =>
  63. Path::Class::File->new(AGENT_RUN_DIR, 'ogp_agent.pid');
  64. use constant STEAM_LICENSE_OK => "Accept";
  65. use constant STEAM_LICENSE => $Cfg::Config{steam_license};
  66. use constant MANUAL_TMP_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'tmp');
  67. use constant STEAMCMD_CLIENT_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'steamcmd');
  68. use constant STEAMCMD_CLIENT_BIN =>
  69. Path::Class::File->new(STEAMCMD_CLIENT_DIR, 'steamcmd.exe');
  70. use constant SCREEN_LOGS_DIR =>
  71. Path::Class::Dir->new(AGENT_RUN_DIR, 'screenlogs');
  72. use constant GAME_STARTUP_DIR =>
  73. Path::Class::Dir->new(AGENT_RUN_DIR, 'startups');
  74. use constant SCREENRC_FILE =>
  75. Path::Class::File->new(AGENT_RUN_DIR, 'ogp_screenrc');
  76. use constant SCREEN_TYPE_HOME => "HOME";
  77. use constant SCREEN_TYPE_UPDATE => "UPDATE";
  78. use constant FD_DIR => Path::Class::Dir->new(AGENT_RUN_DIR, 'FastDownload');
  79. use constant FD_ALIASES_DIR => Path::Class::Dir->new(FD_DIR, 'aliases');
  80. use constant FD_PID_FILE => Path::Class::File->new(FD_DIR, 'fd.pid');
  81. use constant SCHED_PID => Path::Class::File->new(AGENT_RUN_DIR, 'scheduler.pid');
  82. use constant SCHED_TASKS => Path::Class::File->new(AGENT_RUN_DIR, 'scheduler.tasks');
  83. use constant SCHED_LOG_FILE => Path::Class::File->new(AGENT_RUN_DIR, 'scheduler.log');
  84.  
  85. my $no_startups = 0;
  86. my $clear_startups = 0;
  87. our $log_std_out = 0;
  88.  
  89. GetOptions(
  90. 'no-startups' => \$no_startups,
  91. 'clear-startups' => \$clear_startups,
  92. 'log-stdout' => \$log_std_out
  93. );
  94.  
  95. # Starting the agent as root user is not supported anymore.
  96. if ($< == 0)
  97. {
  98. print "ERROR: You are trying to start the agent as root user.";
  99. print "This is not currently supported. If you wish to start the";
  100. print "you need to create a normal user account for it.";
  101. exit 1;
  102. }
  103.  
  104. ### Logger function.
  105. ### @param line the line that is put to the log file.
  106. sub logger
  107. {
  108. my $logcmd = $_[0];
  109. my $also_print = 0;
  110.  
  111. if (@_ == 2)
  112. {
  113. ($also_print) = $_[1];
  114. }
  115.  
  116. $logcmd = localtime() . " $logcmd\n";
  117.  
  118. if ($log_std_out == 1)
  119. {
  120. print "$logcmd";
  121. return;
  122. }
  123. if ($also_print == 1)
  124. {
  125. print "$logcmd";
  126. }
  127.  
  128. open(LOGFILE, '>>', AGENT_LOG_FILE)
  129. or die("Can't open " . AGENT_LOG_FILE . " - $!");
  130. flock(LOGFILE, LOCK_EX) or die("Failed to lock log file.");
  131. seek(LOGFILE, 0, 2) or die("Failed to seek to end of file.");
  132. print LOGFILE "$logcmd" or die("Failed to write to log file.");
  133. flock(LOGFILE, LOCK_UN) or die("Failed to unlock log file.");
  134. close(LOGFILE) or die("Failed to close log file.");
  135. }
  136.  
  137. # Check the screen logs folder
  138. if (!-d SCREEN_LOGS_DIR && !mkdir SCREEN_LOGS_DIR)
  139. {
  140. logger "Could not create " . SCREEN_LOGS_DIR . " directory $!.", 1;
  141. exit -1;
  142. }
  143.  
  144. # Rotate the log file
  145. if (-e AGENT_LOG_FILE)
  146. {
  147. if (-e AGENT_LOG_FILE . ".bak")
  148. {
  149. unlink(AGENT_LOG_FILE . ".bak");
  150. }
  151. logger "Rotating log file";
  152. move(AGENT_LOG_FILE, AGENT_LOG_FILE . ".bak");
  153. logger "New log file created";
  154. }
  155.  
  156. if (check_steam_cmd_client() == -1)
  157. {
  158. print "ERROR: You must download and uncompress the new steamcmd package.";
  159. print "ENSURE TO INSTALL IT IN /OGP/steamcmd directory,";
  160. print "so it can be managed by the agent to install servers.";
  161. exit 1;
  162. }
  163.  
  164. # create the directory for startup flags
  165. if (!-e GAME_STARTUP_DIR)
  166. {
  167. logger "Creating the startups directory " . GAME_STARTUP_DIR . "";
  168. if (!mkdir GAME_STARTUP_DIR)
  169. {
  170. my $message =
  171. "Failed to create the "
  172. . GAME_STARTUP_DIR
  173. . " directory - check permissions. Errno: $!";
  174. logger $message, 1;
  175. exit 1;
  176. }
  177. }
  178. elsif ($clear_startups)
  179. {
  180. opendir(STARTUPDIR, GAME_STARTUP_DIR);
  181. while (my $startup_file = readdir(STARTUPDIR))
  182. {
  183.  
  184. # Skip . and ..
  185. next if $startup_file =~ /^\./;
  186. $startup_file = Path::Class::File->new(GAME_STARTUP_DIR, $startup_file);
  187. logger "Removing " . $startup_file . ".";
  188. unlink($startup_file);
  189. }
  190. closedir(STARTUPDIR);
  191. }
  192. # If the directory already existed check if we need to start some games.
  193. elsif ($no_startups != 1)
  194. {
  195. system('screen -wipe > /dev/null 2>&1');
  196. # Loop through all the startup flags, and call universal startup
  197. opendir(STARTUPDIR, GAME_STARTUP_DIR);
  198. logger "Reading startup flags from " . GAME_STARTUP_DIR . "";
  199. while (my $dirlist = readdir(STARTUPDIR))
  200. {
  201.  
  202. # Skip . and ..
  203. next if $dirlist =~ /^\./;
  204. logger "Found $dirlist";
  205. open(STARTFILE, '<', Path::Class::Dir->new(GAME_STARTUP_DIR, $dirlist))
  206. || logger "Error opening start flag $!";
  207. while (<STARTFILE>)
  208. {
  209. my (
  210. $home_id, $home_path, $server_exe,
  211. $run_dir, $startup_cmd, $server_port,
  212. $server_ip, $cpu, $nice
  213. ) = split(',', $_);
  214.  
  215. if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) ==
  216. 1)
  217. {
  218. logger
  219. "This server ($server_exe on $server_ip : $server_port) is already running (ID: $home_id).";
  220. next;
  221. }
  222.  
  223. logger "Starting server_exe $server_exe from home $home_path.";
  224. universal_start_without_decrypt(
  225. $home_id, $home_path, $server_exe,
  226. $run_dir, $startup_cmd, $server_port,
  227. $server_ip, $cpu, $nice
  228. );
  229. }
  230. close(STARTFILE);
  231. }
  232. closedir(STARTUPDIR);
  233. }
  234.  
  235. # Create the pid file
  236. open(PID, '>', AGENT_PID_FILE)
  237. or die("Can't write to pid file - " . AGENT_PID_FILE . "\n");
  238. print PID "$$\n";
  239. close(PID);
  240.  
  241. logger "Open Game Panel - Agent started - "
  242. . AGENT_VERSION
  243. . " - port "
  244. . AGENT_PORT
  245. . " - PID $$", 1;
  246.  
  247. # Stop previous scheduler process if exists
  248. scheduler_stop();
  249. # Create new object with default dispatcher for scheduled tasks
  250. my $cron = new Schedule::Cron( \&scheduler_dispatcher, {
  251. nofork => 1,
  252. loglevel => 0,
  253. log => sub { print $_[1], "\n"; }
  254. } );
  255.  
  256. $cron->add_entry( "* * * * * *", \&scheduler_read_tasks );
  257. # Run scheduler
  258. $cron->run( {detach=>1, pid_file=>SCHED_PID} );
  259.  
  260. if(-e Path::Class::File->new(FD_DIR, 'Settings.pm'))
  261. {
  262. require "FastDownload/Settings.pm"; # Settings for Fast Download Daemon.
  263. if(defined($FastDownload::Settings{autostart_on_agent_startup}) && $FastDownload::Settings{autostart_on_agent_startup} eq "1")
  264. {
  265. start_fastdl();
  266. }
  267. }
  268.  
  269. my $d = Frontier::Daemon::Forking->new(
  270. methods => {
  271. is_screen_running => \&is_screen_running,
  272. universal_start => \&universal_start,
  273. cpu_count => \&cpu_count,
  274. rfile_exists => \&rfile_exists,
  275. quick_chk => \&quick_chk,
  276. steam_cmd => \&steam_cmd,
  277. get_log => \&get_log,
  278. stop_server => \&stop_server,
  279. send_rcon_command => \&send_rcon_command,
  280. dirlist => \&dirlist,
  281. dirlistfm => \&dirlistfm,
  282. readfile => \&readfile,
  283. writefile => \&writefile,
  284. rebootnow => \&rebootnow,
  285. what_os => \&what_os,
  286. start_file_download => \&start_file_download,
  287. is_file_download_in_progress => \&is_file_download_in_progress,
  288. uncompress_file => \&uncompress_file,
  289. discover_ips => \&discover_ips,
  290. mon_stats => \&mon_stats,
  291. exec => \&exec,
  292. clone_home => \&clone_home,
  293. remove_home => \&remove_home,
  294. start_rsync_install => \&start_rsync_install,
  295. rsync_progress => \&rsync_progress,
  296. restart_server => \&restart_server,
  297. sudo_exec => \&sudo_exec,
  298. master_server_update => \&master_server_update,
  299. secure_path => \&secure_path,
  300. get_chattr => \&get_chattr,
  301. ftp_mgr => \&ftp_mgr,
  302. compress_files => \&compress_files,
  303. stop_fastdl => \&stop_fastdl,
  304. restart_fastdl => \&restart_fastdl,
  305. fastdl_status => \&fastdl_status,
  306. fastdl_get_aliases => \&fastdl_get_aliases,
  307. fastdl_add_alias => \&fastdl_add_alias,
  308. fastdl_del_alias => \&fastdl_del_alias,
  309. fastdl_get_info => \&fastdl_get_info,
  310. fastdl_create_config => \&fastdl_create_config,
  311. agent_restart => \&agent_restart,
  312. scheduler_add_task => \&scheduler_add_task,
  313. scheduler_del_task => \&scheduler_del_task,
  314. scheduler_list_tasks => \&scheduler_list_tasks,
  315. scheduler_edit_task => \&scheduler_edit_task,
  316. },
  317. debug => 4,
  318. LocalPort => AGENT_PORT,
  319. LocalAddr => AGENT_IP,
  320. ReuseAddr => '1'
  321. ) or die "Couldn't start OGP Agent: $!";
  322.  
  323. sub backup_home_log
  324. {
  325. my ($home_id, $log_file) = @_;
  326.  
  327. my $home_backup_dir = SCREEN_LOGS_DIR . "/home_id_" . $home_id;
  328.  
  329. if( ! -e $home_backup_dir )
  330. {
  331. if( ! mkdir $home_backup_dir )
  332. {
  333. logger "Can not create a backup directory at $home_backup_dir.";
  334. return 1;
  335. }
  336. }
  337.  
  338. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  339.  
  340. my $backup_file_name = $mday . $mon . $year . '_' . $hour . 'h' . $min . 'm' . $sec . "s.log";
  341.  
  342. my $output_path = $home_backup_dir . "/" . $backup_file_name;
  343.  
  344. # Used for deleting log files older than DELETE_LOGS_AFTER
  345. my @file_list;
  346. my @find_dirs; # directories to search
  347. my $now = time(); # get current time
  348. my $days;
  349. if((DELETE_LOGS_AFTER =~ /^[+-]?\d+$/) && (DELETE_LOGS_AFTER > 0)){
  350. $days = DELETE_LOGS_AFTER; # how many days old
  351. }else{
  352. $days = 30; # how many days old
  353. }
  354. my $seconds_per_day = 60*60*24; # seconds in a day
  355. my $AGE = $days*$seconds_per_day; # age in seconds
  356. push (@find_dirs, $home_backup_dir);
  357.  
  358. # Create local copy of log file backup in the log_backups folder and current user home directory if SCREEN_LOG_LOCAL = 1
  359. if(SCREEN_LOG_LOCAL == 1)
  360. {
  361. # Create local backups folder
  362. my $local_log_folder = Path::Class::Dir->new("logs_backup");
  363.  
  364. if(!-e $local_log_folder){
  365. mkdir($local_log_folder);
  366. }
  367.  
  368. # Add full path to @find_dirs so that log files older than DELETE_LOGS_AFTER are deleted
  369. my $fullpath_to_local_logs = Path::Class::Dir->new(getcwd(), "logs_backup");
  370. push (@find_dirs, $fullpath_to_local_logs);
  371.  
  372. my $log_local = $local_log_folder . "/" . $backup_file_name;
  373.  
  374. # Delete the local log file if it already exists
  375. if(-e $log_local){
  376. unlink $log_local;
  377. }
  378.  
  379. # If the log file contains UPDATE in the filename, do not allow users to see it since it will contain steam credentials
  380. # Will return -1 for not existing
  381. my $isUpdate = index($log_file,SCREEN_TYPE_UPDATE);
  382.  
  383. if($isUpdate == -1){
  384. copy($log_file,$log_local);
  385. }
  386. }
  387.  
  388. # Delete all files in @find_dirs older than DELETE_LOGS_AFTER days
  389. find ( sub {
  390. my $file = $File::Find::name;
  391. if ( -f $file ) {
  392. push (@file_list, $file);
  393. }
  394. }, @find_dirs);
  395.  
  396. for my $file (@file_list) {
  397. my @stats = stat($file);
  398. if ($now-$stats[9] > $AGE) {
  399. unlink $file;
  400. }
  401. }
  402.  
  403. move($log_file,$output_path);
  404.  
  405. return 0;
  406. }
  407.  
  408. sub create_screen_id
  409. {
  410. my ($screen_type, $home_id) = @_;
  411. return sprintf("OGP_%s_%09d", $screen_type, $home_id);
  412. }
  413.  
  414. sub create_screen_cmd
  415. {
  416. my ($screen_id, $exec_cmd) = @_;
  417. $exec_cmd = replace_OGP_Vars($screen_id, $exec_cmd);
  418. return
  419. sprintf('screen -d -m -t "%1$s" -c ' . SCREENRC_FILE . ' -S %1$s %2$s',
  420. $screen_id, $exec_cmd);
  421.  
  422. }
  423.  
  424. sub create_screen_cmd_loop
  425. {
  426. my ($screen_id, $exec_cmd, $priority, $affinity) = @_;
  427. my $server_start_batfile = $screen_id . "_startup_scr.bat";
  428.  
  429. $exec_cmd = replace_OGP_Vars($screen_id, $exec_cmd);
  430.  
  431. # Create batch file that will launch the process and store PID which will be used for killing later
  432. open (SERV_START_BAT_SCRIPT, '>', $server_start_batfile);
  433.  
  434. my $batch_server_command = ":TOP" . "\r\n"
  435. . "set starttime=%time%" . "\r\n"
  436. . "start " . $priority . " " . $affinity . " /wait " . $exec_cmd . "\r\n"
  437. . "set endtime=%time%" . "\r\n"
  438. . "set /a secs=%endtime:~6,2%" . "\r\n"
  439. . "set /a secs=%secs%-%starttime:~6,2%" . "\r\n"
  440. . "if exist SERVER_STOPPED exit" . "\r\n"
  441. . "if %secs% lss 15 exit" . "\r\n"
  442. . "goto TOP" . "\r\n";
  443.  
  444. print SERV_START_BAT_SCRIPT $batch_server_command;
  445. close (SERV_START_BAT_SCRIPT);
  446.  
  447. my $screen_exec_script = "cmd /Q /C " . $server_start_batfile;
  448.  
  449. return
  450. sprintf('screen -d -m -t "%1$s" -c ' . SCREENRC_FILE . ' -S %1$s %2$s',
  451. $screen_id, $screen_exec_script);
  452.  
  453. }
  454.  
  455. sub replace_OGP_Vars{
  456. # This function replaces constants from game server XML Configs with OGP paths for Steam Auto Updates for example
  457. my ($screen_id, $exec_cmd) = @_;
  458. my $screen_id_for_txt_update = substr ($screen_id, rindex($screen_id, '_') + 1);
  459. my $steamInsFile = $screen_id_for_txt_update . "_install.txt";
  460. my $steamCMDPath = STEAMCMD_CLIENT_DIR;
  461. my $fullPath = Path::Class::File->new($steamCMDPath, $steamInsFile);
  462.  
  463. my $windows_steamCMDPath= `cygpath -wa $steamCMDPath`;
  464. chop $windows_steamCMDPath;
  465. $windows_steamCMDPath =~ s#/#\\#g;
  466.  
  467. # If the install file exists, the game can be auto updated, else it will be ignored by the game for improper syntax
  468. # To generate the install file, the "Install/Update via Steam" button must be clicked on at least once!
  469. if(-e $fullPath){
  470. $exec_cmd =~ s/{OGP_STEAM_CMD_DIR}/$windows_steamCMDPath/g;
  471. $exec_cmd =~ s/{STEAMCMD_INSTALL_FILE}/$steamInsFile/g;
  472. }
  473.  
  474. return $exec_cmd;
  475. }
  476.  
  477. sub encode_list
  478. {
  479. my $encoded_content = '';
  480. foreach (@_)
  481. {
  482. $encoded_content .= encode_base64($_, '\n');
  483. }
  484. return $encoded_content;
  485. }
  486.  
  487. sub decrypt_param
  488. {
  489. my ($param) = @_;
  490. $param = decode_base64($param);
  491. $param = Crypt::XXTEA::decrypt($param, AGENT_KEY);
  492. $param = decode_base64($param);
  493. return $param;
  494. }
  495.  
  496. sub decrypt_params
  497. {
  498. my @params;
  499. foreach my $param (@_)
  500. {
  501. $param = &decrypt_param($param);
  502. push(@params, $param);
  503. }
  504. return @params;
  505. }
  506.  
  507. sub check_steam_cmd_client
  508. {
  509. if (STEAM_LICENSE ne STEAM_LICENSE_OK)
  510. {
  511. logger "Steam license not accepted, stopping Steam client check.";
  512. return 0;
  513. }
  514. if (!-d STEAMCMD_CLIENT_DIR && !mkdir STEAMCMD_CLIENT_DIR)
  515. {
  516. logger "Could not create " . STEAMCMD_CLIENT_DIR . " directory $!.", 1;
  517. exit -1;
  518. }
  519. if (!-w STEAMCMD_CLIENT_DIR)
  520. {
  521. logger "Steam client dir '"
  522. . STEAMCMD_CLIENT_DIR
  523. . "' not writable. Unable to get Steam client.";
  524. return -1;
  525. }
  526. if (!-f STEAMCMD_CLIENT_BIN)
  527. {
  528. logger "The Steam client, steamcmd, does not exist yet, installing...";
  529. my $steam_client_file = 'steamcmd.zip';
  530. my $steam_client_path = Path::Class::File->new(STEAMCMD_CLIENT_DIR, $steam_client_file);
  531. my $steam_client_url =
  532. "http://media.steampowered.com/installer/" . $steam_client_file;
  533. logger "Downloading the Steam client from $steam_client_url to '"
  534. . $steam_client_path . "'.";
  535.  
  536. my $ua = LWP::UserAgent->new;
  537. $ua->agent('Mozilla/5.0');
  538. my $response = $ua->get($steam_client_url, ':content_file' => "$steam_client_path");
  539.  
  540. unless ($response->is_success)
  541. {
  542. logger "Failed to download steam installer from "
  543. . $steam_client_url
  544. . ".", 1;
  545. return -1;
  546. }
  547. if (-f $steam_client_path)
  548. {
  549. logger "Uncompressing $steam_client_path";
  550. if ( uncompress_file_without_decrypt($steam_client_path, STEAMCMD_CLIENT_DIR) != 1 )
  551. {
  552. unlink($steam_client_path);
  553. logger "Unable to uncompress $steam_client_path, the file has been removed.";
  554. return -1;
  555. }
  556. unlink($steam_client_path);
  557. }
  558. }
  559. if (!-x STEAMCMD_CLIENT_BIN)
  560. {
  561. if ( ! chmod 0755, STEAMCMD_CLIENT_BIN )
  562. {
  563. logger "Unable to apply execution permission to ".STEAMCMD_CLIENT_BIN.".";
  564. }
  565. }
  566. return 1;
  567. }
  568.  
  569. sub is_screen_running
  570. {
  571. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  572. my ($screen_type, $home_id) = decrypt_params(@_);
  573. return is_screen_running_without_decrypt($screen_type, $home_id);
  574. }
  575.  
  576. sub is_screen_running_without_decrypt
  577. {
  578. my ($screen_type, $home_id) = @_;
  579.  
  580. my $screen_id = create_screen_id($screen_type, $home_id);
  581.  
  582. my $is_running = `screen -list | grep $screen_id`;
  583.  
  584. if ($is_running =~ /^\s*$/)
  585. {
  586. return 0;
  587. }
  588. else
  589. {
  590. return 1;
  591. }
  592. }
  593.  
  594. # Delete Server Stopped Status File:
  595. sub deleteStoppedStatFile
  596. {
  597. my ($home_path) = @_;
  598. my $server_stop_status_file = Path::Class::File->new($home_path, "SERVER_STOPPED");
  599. if(-e $server_stop_status_file)
  600. {
  601. unlink $server_stop_status_file;
  602. }
  603. }
  604.  
  605. # Universal startup function
  606. sub universal_start
  607. {
  608. chomp(@_);
  609. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  610. return universal_start_without_decrypt(decrypt_params(@_));
  611. }
  612.  
  613. # Split to two parts because of internal calls.
  614. sub universal_start_without_decrypt
  615. {
  616. my (
  617. $home_id, $home_path, $server_exe, $run_dir, $startup_cmd,
  618. $server_port, $server_ip, $cpu, $nice
  619. ) = @_;
  620.  
  621. if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) == 1)
  622. {
  623. logger "This server is already running (ID: $home_id).";
  624. return -14;
  625. }
  626.  
  627. if (!-e $home_path)
  628. {
  629. logger "Can't find server's install path [ $home_path ].";
  630. return -10;
  631. }
  632.  
  633. # Some game require that we are in the directory where the binary is.
  634. my $game_binary_dir = Path::Class::Dir->new($home_path, $run_dir);
  635. if ( -e $game_binary_dir && !chdir $game_binary_dir)
  636. {
  637. logger "Could not change to server binary directory $game_binary_dir.";
  638. return -12;
  639. }
  640.  
  641. if (!-x $server_exe)
  642. {
  643. if (!chmod 0755, $server_exe)
  644. {
  645. logger "The $server_exe file is not executable.";
  646. return -13;
  647. }
  648. }
  649.  
  650. my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
  651.  
  652. # Create affinity and priority strings
  653. my $priority;
  654. my $affinity;
  655.  
  656. if($nice ne "NA")
  657. {
  658. if( $nice <= 19 and $nice >= 11 )
  659. {
  660. $priority = "/low";
  661. }
  662. elsif( $nice <= 10 and $nice >= 1 )
  663. {
  664. $priority = "/belownormal";
  665. }
  666. elsif( $nice == 0 )
  667. {
  668. $priority = "/normal";
  669. }
  670. elsif( $nice <= -1 and $nice >= -8 )
  671. {
  672. $priority = "/abovenormal";
  673. }
  674. elsif( $nice <= -9 and $nice >= -18 )
  675. {
  676. $priority = "/high";
  677. }
  678. elsif( $nice == -19 )
  679. {
  680. $priority = "/realtime";
  681. }
  682. }
  683. else
  684. {
  685. $priority = "";
  686. }
  687.  
  688. if($cpu ne "NA" and $cpu ne "" )
  689. {
  690.  
  691. $affinity = "/affinity $cpu";
  692. }
  693. else
  694. {
  695. $affinity = "";
  696. }
  697.  
  698. my $win_game_binary_dir = `cygpath -wa $game_binary_dir`;
  699. chomp $win_game_binary_dir;
  700. $win_game_binary_dir =~ s/\\/\\\\/g;
  701. # Create the startup string.
  702. my ($file_extension) = $server_exe =~ /(\.[^.]+)$/;
  703.  
  704. my $cli_bin;
  705.  
  706. # Create bash file to respawn process if it crashes or exits without user interaction
  707. # If a user stops the server, the process will not respawn
  708.  
  709. if($file_extension eq ".jar")
  710. {
  711. if(defined($Cfg::Preferences{ogp_autorestart_server}) && $Cfg::Preferences{ogp_autorestart_server} eq "1"){
  712. deleteStoppedStatFile($home_path);
  713. $cli_bin = create_screen_cmd_loop($screen_id, "$startup_cmd", $priority, $affinity);
  714. }else{
  715. $cli_bin = create_screen_cmd($screen_id, "cmd /Q /C start $priority $affinity /WAIT $startup_cmd");
  716. }
  717. }
  718. elsif(($file_extension eq ".sh")||($file_extension eq ".bash"))
  719. {
  720. # There is no software made for windows that uses bash by default,
  721. # but it can be a good way to improve the server startup. To be able to use
  722. # sh/bash scripts as server executable I added this piece to the agent:
  723. if(defined($Cfg::Preferences{ogp_autorestart_server}) && $Cfg::Preferences{ogp_autorestart_server} eq "1"){
  724. deleteStoppedStatFile($home_path);
  725. $cli_bin = create_screen_cmd_loop($screen_id, "bash $game_binary_dir/$server_exe $startup_cmd", $priority, $affinity);
  726. }else{
  727. $cli_bin = create_screen_cmd($screen_id, "cmd /Q /C start $priority $affinity /WAIT bash $game_binary_dir/$server_exe $startup_cmd");
  728. }
  729. }
  730. else
  731. {
  732. if(defined($Cfg::Preferences{ogp_autorestart_server}) && $Cfg::Preferences{ogp_autorestart_server} eq "1"){
  733. deleteStoppedStatFile($home_path);
  734. $cli_bin = create_screen_cmd_loop($screen_id, "$win_game_binary_dir\\\\$server_exe $startup_cmd", $priority, $affinity);
  735. }else{
  736. $cli_bin = create_screen_cmd($screen_id, "cmd /Q /C start $priority $affinity /WAIT $win_game_binary_dir\\\\$server_exe $startup_cmd");
  737. }
  738. }
  739.  
  740. $home_path =~ s/\\/\//g;
  741.  
  742. my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
  743. backup_home_log( $home_id, $log_file );
  744.  
  745. my $clean_cli_bin = $cli_bin;
  746. $clean_cli_bin =~ s/\\\\/\\/g;
  747. logger
  748. "Startup command [ $clean_cli_bin ] will be executed in dir $game_binary_dir.";
  749.  
  750. system($cli_bin);
  751.  
  752. # Create startup file for the server.
  753. my $startup_file =
  754. Path::Class::File->new(GAME_STARTUP_DIR, "$server_ip-$server_port");
  755.  
  756. if (open(STARTUP, '>', $startup_file))
  757. {
  758. print STARTUP
  759. "$home_id,$home_path,$server_exe,$run_dir,$startup_cmd,$server_port,$server_ip,$cpu,$nice";
  760. logger "Created startup flag for $server_ip-$server_port";
  761. close(STARTUP);
  762. }
  763. else
  764. {
  765. logger "Cannot create file in " . $startup_file . " : $!";
  766. }
  767. return 1;
  768. }
  769.  
  770. # Returns the number of CPUs available.
  771. sub cpu_count
  772. {
  773. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  774. if (!-e "/proc/cpuinfo")
  775. {
  776. return "ERROR - Missing /proc/cpuinfo";
  777. }
  778.  
  779. open(CPUINFO, '<', "/proc/cpuinfo")
  780. or return "ERROR - Cannot open /proc/cpuinfo";
  781.  
  782. my $cpu_count = 0;
  783.  
  784. while (<CPUINFO>)
  785. {
  786. chomp;
  787. next if $_ !~ /^processor/;
  788. $cpu_count++;
  789. }
  790. close(CPUINFO);
  791. return "$cpu_count";
  792. }
  793.  
  794. ### File exists check ####
  795. # Simple a way to check if a file exists using the remote agent
  796. #
  797. # @return 0 when file exists.
  798. # @return 1 when file does not exist.
  799. sub rfile_exists
  800. {
  801. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  802. chdir AGENT_RUN_DIR;
  803. my $checkFile = decrypt_param(@_);
  804.  
  805. if (-e $checkFile)
  806. {
  807. return 0;
  808. }
  809. else
  810. {
  811. return 1;
  812. }
  813. }
  814.  
  815. ##### Quick check to verify agent is up and running
  816. # Used to quickly see if the agent is online, and if the keys match.
  817. # The message that is sent to the agent must be hello, if not then
  818. # it is intrepret as encryption key missmatch.
  819. #
  820. # @return 1 when encrypted message is not 'hello'
  821. # @return 0 when check is ok.
  822. sub quick_chk
  823. {
  824. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  825. my $dec_check = &decrypt_param(@_);
  826. if ($dec_check ne 'hello')
  827. {
  828. logger "ERROR - Encryption key mismatch! Returning 1 to asker.";
  829. return 1;
  830. }
  831. return 0;
  832. }
  833.  
  834. ### Return -10 If home path is not found.
  835. ### Return -9 If log type was invalid.
  836. ### Return -8 If log file was not found.
  837. ### 0 reserved for connection problems.
  838. ### Return 1;content If log found and screen running.
  839. ### Return 2;content If log found but screen is not running.
  840. sub get_log
  841. {
  842. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  843. my ($screen_type, $home_id, $home_path, $nb_of_lines) = decrypt_params(@_);
  844.  
  845. if (!chdir $home_path)
  846. {
  847. logger "Can't change to server's install path [ $home_path ].";
  848. return -10;
  849. }
  850.  
  851. if ( ($screen_type eq SCREEN_TYPE_UPDATE)
  852. && ($screen_type eq SCREEN_TYPE_HOME))
  853. {
  854. logger "Invalid screen type '$screen_type'.";
  855. return -9;
  856. }
  857.  
  858. my $screen_id = create_screen_id($screen_type, $home_id);
  859.  
  860. my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
  861.  
  862. chmod 0644, $log_file;
  863.  
  864. # Create local copy of current log file if SCREEN_LOG_LOCAL = 1
  865. if(SCREEN_LOG_LOCAL == 1)
  866. {
  867. my $log_local = Path::Class::File->new($home_path, "LOG_$screen_type.txt");
  868. if ( -e $log_local )
  869. {
  870. unlink $log_local;
  871. }
  872.  
  873. # Copy log file only if it's not an UPDATE type as it may contain steam credentials
  874. if($screen_type eq SCREEN_TYPE_HOME){
  875. copy($log_file, $log_local);
  876. }
  877. }
  878.  
  879. # Regenerate the log file if it doesn't exist
  880. unless ( -e $log_file )
  881. {
  882. if (open(NEWLOG, '>', $log_file))
  883. {
  884. logger "Log file missing, regenerating: " . $log_file;
  885. print NEWLOG "Log file missing, started new log\n";
  886. close(NEWLOG);
  887. }
  888. else
  889. {
  890. logger "Cannot regenerate log file in " . $log_file . " : $!";
  891. return -8;
  892. }
  893. }
  894.  
  895. # Return a few lines of output to the web browser
  896. my(@modedlines) = `tail -n $nb_of_lines $log_file`;
  897.  
  898. my $linecount = 0;
  899.  
  900. foreach my $line (@modedlines) {
  901. #Text replacements to remove the Steam user login from steamcmd logs for security reasons.
  902. $line =~ s/login .*//g;
  903. $line =~ s/Logging .*//g;
  904. $line =~ s/set_steam_guard_code.*//g;
  905. $line =~ s/force_install_dir.*//g;
  906. #Text replacements to remove empty lines.
  907. $line =~ s/^ +//g;
  908. $line =~ s/^\t+//g;
  909. $line =~ s/^\e+//g;
  910. #Remove � from console output when master server update is running.
  911. $line =~ s/�//g;
  912. $modedlines[$linecount]=$line;
  913. $linecount++;
  914. }
  915.  
  916. my $encoded_content = encode_list(@modedlines);
  917. chdir AGENT_RUN_DIR;
  918. if(is_screen_running_without_decrypt($screen_type, $home_id) == 1)
  919. {
  920. return "1;" . $encoded_content;
  921. }
  922. else
  923. {
  924. return "2;" . $encoded_content;
  925. }
  926. }
  927.  
  928. # stop server function
  929. sub stop_server
  930. {
  931. chomp(@_);
  932. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  933. return stop_server_without_decrypt(decrypt_params(@_));
  934. }
  935.  
  936. ##### Stop server without decrypt
  937. ### Return 1 when error occurred on decryption.
  938. ### Return 0 on success
  939. sub stop_server_without_decrypt
  940. {
  941. my ($home_id, $server_ip, $server_port, $control_protocol,
  942. $control_password, $control_type, $home_path) = @_;
  943.  
  944. my $startup_file = Path::Class::File->new(GAME_STARTUP_DIR, "$server_ip-$server_port");
  945.  
  946. if (-e $startup_file)
  947. {
  948. logger "Removing startup flag " . $startup_file . "";
  949. unlink($startup_file)
  950. or logger "Cannot remove the startup flag file $startup_file $!";
  951. }
  952.  
  953. # Create file indicator that the game server has been stopped if defined
  954. if(defined($Cfg::Preferences{ogp_autorestart_server}) && $Cfg::Preferences{ogp_autorestart_server} eq "1"){
  955.  
  956. # Get current directory and chdir into the game's home dir
  957. my $curDir = getcwd();
  958. chdir $home_path;
  959.  
  960. # Create stopped indicator file used by autorestart of OGP if server crashes
  961. open(STOPFILE, '>', "SERVER_STOPPED");
  962. close(STOPFILE);
  963.  
  964. # Return to original directory
  965. chdir $curDir;
  966. }
  967.  
  968. my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
  969. my $get_screen_pid = "screen -list | grep $screen_id | cut -f1 -d'.' | sed '".'s/\W//g'."'";
  970. my $screen_pid = `$get_screen_pid`;
  971. chomp $screen_pid;
  972. # Some validation checks for the variables.
  973. if ($server_ip =~ /^\s*$/ || $server_port < 0 || $server_port > 65535)
  974. {
  975. logger("Invalid IP:Port given $server_ip:$server_port.");
  976. return 1;
  977. }
  978.  
  979. if ($control_password !~ /^\s*$/ and $control_protocol ne "")
  980. {
  981. if ($control_protocol eq "rcon")
  982. {
  983. use KKrcon::KKrcon;
  984. my $rcon = new KKrcon(
  985. Password => $control_password,
  986. Host => $server_ip,
  987. Port => $server_port,
  988. Type => $control_type
  989. );
  990.  
  991. my $rconCommand = "quit";
  992. $rcon->execute($rconCommand);
  993. }
  994. elsif ($control_protocol eq "rcon2")
  995. {
  996. use KKrcon::HL2;
  997. my $rcon2 = new HL2(
  998. hostname => $server_ip,
  999. port => $server_port,
  1000. password => $control_password,
  1001. timeout => 2
  1002. );
  1003.  
  1004. my $rconCommand = "quit";
  1005. $rcon2->run($rconCommand);
  1006. }
  1007. system('screen -wipe > /dev/null 2>&1');
  1008. }
  1009. else
  1010. {
  1011. logger "Control protocol not supported. Using kill signal to stop the server.";
  1012. my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
  1013. system("cmd /C taskkill /f /fi 'PID eq $screen_pid' /T");
  1014. system('screen -wipe > /dev/null 2>&1');
  1015. }
  1016.  
  1017. if (is_screen_running_without_decrypt(SCREEN_TYPE_HOME, $home_id) == 1)
  1018. {
  1019. logger "Control protocol not responding. Using kill signal.";
  1020. system("cmd /C taskkill /f /fi 'PID eq $screen_pid' /T");
  1021. system('screen -wipe > /dev/null 2>&1');
  1022. logger "Server ID $home_id:Stopped server running on $server_ip:$server_port.";
  1023. return 0;
  1024. }
  1025. else
  1026. {
  1027. logger "Server ID $home_id:Stopped server running on $server_ip:$server_port.";
  1028. return 0;
  1029. }
  1030. }
  1031.  
  1032. ##### Send RCON command
  1033. ### Return 0 when error occurred on decryption.
  1034. ### Return 1 on success
  1035. sub send_rcon_command
  1036. {
  1037. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1038. my ($home_id, $server_ip, $server_port, $control_protocol,
  1039. $control_password, $control_type, $rconCommand) = decrypt_params(@_);
  1040.  
  1041. # legacy console
  1042. if ($control_protocol eq "lcon")
  1043. {
  1044. my $screen_id = create_screen_id(SCREEN_TYPE_HOME, $home_id);
  1045. system('screen -S '.$screen_id.' -p 0 -X stuff "'.$rconCommand.'$(printf \\\\r)"');
  1046. logger "Sending legacy console command to ".$screen_id.": \n$rconCommand \n .";
  1047. if ($? == 0)
  1048. {
  1049. my(@modedlines) = "$rconCommand";
  1050. my $encoded_content = encode_list(@modedlines);
  1051. return "1;" . $encoded_content;
  1052. }
  1053. return 0;
  1054. }
  1055.  
  1056. # Some validation checks for the variables.
  1057. if ($server_ip =~ /^\s*$/ || $server_port < 0 || $server_port > 65535)
  1058. {
  1059. logger("Invalid IP:Port given $server_ip:$server_port.");
  1060. return 0;
  1061. }
  1062.  
  1063. if ($control_password !~ /^\s*$/)
  1064. {
  1065. if ($control_protocol eq "rcon")
  1066. {
  1067. use KKrcon::KKrcon;
  1068. my $rcon = new KKrcon(
  1069. Password => $control_password,
  1070. Host => $server_ip,
  1071. Port => $server_port,
  1072. Type => $control_type
  1073. );
  1074.  
  1075. logger "Sending RCON command to $server_ip:$server_port: \n$rconCommand \n .";
  1076.  
  1077. my(@modedlines) = $rcon->execute($rconCommand);
  1078. my $encoded_content = encode_list(@modedlines);
  1079. return "1;" . $encoded_content;
  1080. }
  1081. else
  1082. {
  1083. if ($control_protocol eq "rcon2")
  1084. {
  1085. use KKrcon::HL2;
  1086. my $rcon2 = new HL2(
  1087. hostname => $server_ip,
  1088. port => $server_port,
  1089. password => $control_password,
  1090. timeout => 2
  1091. );
  1092.  
  1093. logger "Sending RCON command to $server_ip:$server_port: \n $rconCommand \n .";
  1094.  
  1095. my(@modedlines) = $rcon2->run($rconCommand);
  1096. my $encoded_content = encode_list(@modedlines);
  1097. return "1;" . $encoded_content;
  1098. }
  1099. }
  1100. }
  1101. else
  1102. {
  1103. logger "Control protocol PASSWORD NOT SET.";
  1104. return -10;
  1105. }
  1106. }
  1107.  
  1108. ##### Returns a directory listing
  1109. ### @return List of directories if everything OK.
  1110. ### @return 0 If the directory is not found.
  1111. ### @return -1 If cannot open the directory.
  1112. sub dirlist
  1113. {
  1114. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1115. my ($datadir) = &decrypt_param(@_);
  1116. logger "Asked for dirlist of $datadir directory.";
  1117. if (!-d $datadir)
  1118. {
  1119. logger "ERROR - Directory [ $datadir ] not found!";
  1120. return -1;
  1121. }
  1122. if (!opendir(DIR, $datadir))
  1123. {
  1124. logger "ERROR - Can't open $datadir: $!";
  1125. return -2;
  1126. }
  1127. my @dirlist = readdir(DIR);
  1128. closedir(DIR);
  1129. return join(";", @dirlist);
  1130. }
  1131.  
  1132. ##### Returns a directory listing with extra info the filemanager
  1133. ### @return List of directories if everything OK.
  1134. ### @return 1 If the directory is empty.
  1135. ### @return -1 If the directory is not found.
  1136. ### @return -2 If cannot open the directory.
  1137. sub dirlistfm
  1138. {
  1139. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1140. my $datadir = &decrypt_param(@_);
  1141.  
  1142. logger "Asked for dirlist of $datadir directory.";
  1143.  
  1144. if (!-d $datadir)
  1145. {
  1146. logger "ERROR - Directory [ $datadir ] not found!";
  1147. return -1;
  1148. }
  1149.  
  1150. if (!opendir(DIR, $datadir))
  1151. {
  1152. logger "ERROR - Can't open $datadir: $!";
  1153. return -2;
  1154. }
  1155.  
  1156. my %dirfiles = ();
  1157.  
  1158. my (
  1159. $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
  1160. $size, $atime, $mtime, $ctime, $blksize, $blocks
  1161. );
  1162.  
  1163. my $count = 0;
  1164.  
  1165. chdir($datadir);
  1166.  
  1167. while (readdir(DIR))
  1168. {
  1169. #skip the . and .. special dirs
  1170. next if $_ eq '.';
  1171. next if $_ eq '..';
  1172. #print "Dir list is" . $_."\n";
  1173. #Stat the file to get ownership and size
  1174. (
  1175. $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
  1176. $size, $atime, $mtime, $ctime, $blksize, $blocks
  1177. ) = stat($_);
  1178.  
  1179. $uid = getpwuid($uid);
  1180. $gid = getgrgid($gid);
  1181.  
  1182. #This if else logic determines what it is, File, Directory, other
  1183. if (-T $_)
  1184. {
  1185. # print "File\n";
  1186. $dirfiles{'files'}{$count}{'filename'} = $_;
  1187. $dirfiles{'files'}{$count}{'size'} = $size;
  1188. $dirfiles{'files'}{$count}{'user'} = $uid;
  1189. $dirfiles{'files'}{$count}{'group'} = $gid;
  1190. }
  1191. elsif (-d $_)
  1192. {
  1193. # print "Dir\n";
  1194. $dirfiles{'directorys'}{$count}{'filename'} = $_;
  1195. $dirfiles{'directorys'}{$count}{'size'} = $size;
  1196. $dirfiles{'directorys'}{$count}{'user'} = $uid;
  1197. $dirfiles{'directorys'}{$count}{'group'} = $gid;
  1198. }
  1199. elsif (-B $_)
  1200. {
  1201. #print "File\n";
  1202. $dirfiles{'binarys'}{$count}{'filename'} = $_;
  1203. $dirfiles{'binarys'}{$count}{'size'} = $size;
  1204. $dirfiles{'binarys'}{$count}{'user'} = $uid;
  1205. $dirfiles{'binarys'}{$count}{'group'} = $gid;
  1206. }
  1207. else
  1208. {
  1209. #print "Unknown\n"
  1210. #will be listed as common files;
  1211. $dirfiles{'files'}{$count}{'filename'} = $_;
  1212. $dirfiles{'files'}{$count}{'size'} = $size;
  1213. $dirfiles{'files'}{$count}{'user'} = $uid;
  1214. $dirfiles{'files'}{$count}{'group'} = $gid;
  1215. }
  1216. $count++;
  1217. }
  1218. closedir(DIR);
  1219.  
  1220. if ($count eq 0)
  1221. {
  1222. logger "Empty directory $datadir.";
  1223. return 1;
  1224. }
  1225.  
  1226. chdir AGENT_RUN_DIR;
  1227. #Now we return it to the webpage, as array
  1228. return {%dirfiles};
  1229. }
  1230.  
  1231. ###### Returns the contents of a text file
  1232. sub readfile
  1233. {
  1234. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1235. chdir AGENT_RUN_DIR;
  1236. my $userfile = &decrypt_param(@_);
  1237.  
  1238. unless ( -e $userfile )
  1239. {
  1240. if (open(BLANK, '>', $userfile))
  1241. {
  1242. close(BLANK);
  1243. }
  1244. }
  1245.  
  1246. if (!open(USERFILE, '<', $userfile))
  1247. {
  1248. logger "ERROR - Can't open file $userfile for reading.";
  1249. return -1;
  1250. }
  1251.  
  1252. my ($wholefile, $buf);
  1253.  
  1254. while (read(USERFILE, $buf, 60 * 57))
  1255. {
  1256. $wholefile .= encode_base64($buf);
  1257. }
  1258. close(USERFILE);
  1259.  
  1260. if(!defined $wholefile)
  1261. {
  1262. return "1; ";
  1263. }
  1264.  
  1265. return "1;" . $wholefile;
  1266. }
  1267.  
  1268. ###### Backs up file, then writes data to new file
  1269. ### @return 1 On success
  1270. ### @return 0 In case of a failure
  1271. sub writefile
  1272. {
  1273. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1274. chdir AGENT_RUN_DIR;
  1275. # $writefile = file we're editing, $filedata = the contents were writing to it
  1276. my ($writefile, $filedata) = &decrypt_params(@_);
  1277. if (!-e $writefile)
  1278. {
  1279. open FILE, ">", $writefile;
  1280. }
  1281. else
  1282. {
  1283. # backup the existing file
  1284. logger
  1285. "Backing up file $writefile to $writefile.bak before writing new databefore writing new data.";
  1286. if (!copy("$writefile", "$writefile.bak"))
  1287. {
  1288. logger
  1289. "ERROR - Failed to backup $writefile to $writefile.bak. Error: $!";
  1290. return 0;
  1291. }
  1292. }
  1293. if (!-w $writefile)
  1294. {
  1295. logger "ERROR - File [ $writefile ] is not writeable!";
  1296. return 0;
  1297. }
  1298. if (!open(WRITER, '>', $writefile))
  1299. {
  1300. logger "ERROR - Failed to open $writefile for writing.";
  1301. return 0;
  1302. }
  1303. $filedata = decode_base64($filedata);
  1304. $filedata =~ s/\r//g;
  1305. print WRITER "$filedata";
  1306. close(WRITER);
  1307. logger "Wrote $writefile successfully!";
  1308. return 1;
  1309. }
  1310.  
  1311. ###### Reboots the server remotely through panel
  1312. ### @return 1 On success
  1313. ### @return 0 In case of a failure
  1314. sub rebootnow
  1315. {
  1316. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1317. system('shutdown -r -t 10');
  1318. logger "Scheduled system reboot to occur in 10 seconds successfully!";
  1319. return 1;
  1320. }
  1321.  
  1322. # Determine the os of the agent machine.
  1323. sub what_os
  1324. {
  1325. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1326. logger "Asking for OS type";
  1327. my $ret = system('which uname >/dev/null 2>&1');
  1328. if ($ret eq 0)
  1329. {
  1330. my $os = `\$(which uname) -a`;
  1331. chomp $os;
  1332. logger "OS is $os";
  1333. return "$os";
  1334. }
  1335. else
  1336. {
  1337. logger "Cannot determine OS..that is odd";
  1338. return "Unknown";
  1339. }
  1340. }
  1341.  
  1342. ### @return PID of the download process if started succesfully.
  1343. ### @return -1 If could not create temporary download directory.
  1344. ### @return -2 If could not create destination directory.
  1345. ### @return -3 If resources unavailable.
  1346. sub start_file_download
  1347. {
  1348. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1349. my ($url, $destination, $filename, $action, $post_script) = &decrypt_params(@_);
  1350. logger
  1351. "Starting to download URL $url. Destination: $destination - Filename: $filename";
  1352.  
  1353. if (!-e $destination)
  1354. {
  1355. logger "Creating destination directory.";
  1356. if (!mkpath $destination )
  1357. {
  1358. logger "Could not create destination '$destination' directory : $!";
  1359. return -2;
  1360. }
  1361. }
  1362.  
  1363. my $download_file_path = Path::Class::File->new($destination, "$filename");
  1364.  
  1365. my $pid = fork();
  1366. if (not defined $pid)
  1367. {
  1368. logger "Could not allocate resources for download.";
  1369. return -3;
  1370. }
  1371.  
  1372. # Only the forked child goes here.
  1373. elsif ($pid == 0)
  1374. {
  1375. my $ua = LWP::UserAgent->new;
  1376. $ua->agent('Mozilla/5.0');
  1377. $ua->ssl_opts(verify_hostname => 0,
  1378. SSL_verify_mode => 0x00);
  1379. my $response = $ua->get($url, ':content_file' => "$download_file_path");
  1380.  
  1381. if ($response->is_success)
  1382. {
  1383. logger "Successfully fetched $url and stored it to $download_file_path. Retval: ".$response->status_line;
  1384.  
  1385. if (!-e $download_file_path)
  1386. {
  1387. logger "File $download_file_path does not exist.";
  1388. exit(0);
  1389. }
  1390.  
  1391. if ($action eq "uncompress")
  1392. {
  1393. logger "Starting file uncompress as ordered.";
  1394. uncompress_file_without_decrypt($download_file_path,
  1395. $destination);
  1396. }
  1397. }
  1398. else
  1399. {
  1400. logger
  1401. "Unable to fetch $url, or save to $download_file_path. Retval: ".$response->status_line;
  1402. exit(0);
  1403. }
  1404.  
  1405. # Child process must exit.
  1406. exit(0);
  1407. }
  1408. else
  1409. {
  1410. if ($post_script ne "")
  1411. {
  1412. logger "Running postscript commands.";
  1413. my @postcmdlines = split /[\r\n]+/, $post_script;
  1414. my $postcmdfile = $destination."/".'postinstall.sh';
  1415. open FILE, '>', $postcmdfile;
  1416. print FILE "cd $destination\n";
  1417. print FILE "while kill -0 $pid >/dev/null 2>&1\n";
  1418. print FILE "do\n";
  1419. print FILE " sleep 1\n";
  1420. print FILE "done\n";
  1421. foreach my $line (@postcmdlines) {
  1422. print FILE "$line\n";
  1423. }
  1424. print FILE "rm -f $destination/postinstall.sh\n";
  1425. close FILE;
  1426. chmod 0755, $postcmdfile;
  1427. my $screen_id = create_screen_id("post_script", $pid);
  1428. my $cli_bin = create_screen_cmd($screen_id, "bash $postcmdfile");
  1429. system($cli_bin);
  1430. }
  1431. logger "Download process for $download_file_path has pid number $pid.";
  1432. return "$pid";
  1433. }
  1434. }
  1435.  
  1436. sub check_b4_chdir
  1437. {
  1438. my ( $path ) = @_;
  1439.  
  1440. if (!-e $path)
  1441. {
  1442. logger "$path does not exist yet. Trying to create it...";
  1443.  
  1444. if (!mkpath($path))
  1445. {
  1446. logger "Error creating $path . Errno: $!";
  1447. return -1;
  1448. }
  1449. }
  1450.  
  1451. if (!chdir $path)
  1452. {
  1453. logger "Unable to change dir to '$path'.";
  1454. return -1;
  1455. }
  1456.  
  1457. return 0;
  1458. }
  1459.  
  1460. sub create_bash_scripts
  1461. {
  1462. my ( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds ) = @_;
  1463.  
  1464. $home_path =~ s/('+)/'\"$1\"'/g;
  1465. $bash_scripts_path =~ s/('+)/'\"$1\"'/g;
  1466.  
  1467. my @precmdlines = split /[\r\n]+/, $precmd;
  1468. my $precmdfile = 'preinstall.sh';
  1469. open FILE, '>', $precmdfile;
  1470. print FILE "cd '$home_path'\n";
  1471. foreach my $line (@precmdlines) {
  1472. print FILE "$line\n";
  1473. }
  1474. close FILE;
  1475. chmod 0755, $precmdfile;
  1476.  
  1477. my @postcmdlines = split /[\r\n]+/, $postcmd;
  1478. my $postcmdfile = 'postinstall.sh';
  1479. open FILE, '>', $postcmdfile;
  1480. print FILE "cd '$home_path'\n";
  1481. foreach my $line (@postcmdlines) {
  1482. print FILE "$line\n";
  1483. }
  1484. print FILE "cd '$bash_scripts_path'\n".
  1485. "rm -f preinstall.sh\n".
  1486. "rm -f postinstall.sh\n".
  1487. "rm -f runinstall.sh\n";
  1488. close FILE;
  1489. chmod 0755, $postcmdfile;
  1490.  
  1491. my $installfile = 'runinstall.sh';
  1492. open FILE, '>', $installfile;
  1493. print FILE "#!/bin/bash\n".
  1494. "cd '$bash_scripts_path'\n".
  1495. "./$precmdfile\n";
  1496. foreach my $installcmd (@installcmds)
  1497. {
  1498. print FILE "$installcmd\n";
  1499. }
  1500. print FILE "wait ".'${!}'."\n".
  1501. "cd '$bash_scripts_path'\n".
  1502. "./$postcmdfile\n";
  1503. close FILE;
  1504. chmod 0755, $installfile;
  1505.  
  1506. return $installfile;
  1507. }
  1508.  
  1509. #### Run the rsync update ####
  1510. ### @return 1 If update started
  1511. ### @return 0 In error case.
  1512. sub start_rsync_install
  1513. {
  1514. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1515. my ($home_id, $home_path, $url, $exec_folder_path, $exec_path, $precmd, $postcmd) = decrypt_params(@_);
  1516.  
  1517. if ( check_b4_chdir($home_path) != 0)
  1518. {
  1519. return 0;
  1520. }
  1521.  
  1522. my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
  1523.  
  1524. if ( check_b4_chdir($bash_scripts_path) != 0)
  1525. {
  1526. return 0;
  1527. }
  1528.  
  1529. # Rsync install require the rsync binary to exist in the system
  1530. # to enable this functionality.
  1531. my $rsync_binary = Path::Class::File->new("/usr/bin", "rsync");
  1532.  
  1533. if (!-f $rsync_binary)
  1534. {
  1535. logger "Failed to start rsync update from "
  1536. . $url
  1537. . " to $home_path. Error: Rsync client not installed.";
  1538. return 0;
  1539. }
  1540.  
  1541. my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
  1542.  
  1543. my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
  1544.  
  1545. backup_home_log( $home_id, $log_file );
  1546.  
  1547. my $path = $home_path;
  1548. $path =~ s/('+)/'\"$1\"'/g;
  1549. my @installcmds = ("/usr/bin/rsync --archive --compress --copy-links --update --verbose rsync://$url '$path'",
  1550. "cd '$path'",
  1551. "find -iname \\\*.exe -exec chmod -f +x {} \\\;",
  1552. "find -iname \\\*.bat -exec chmod -f +x {} \\\;");
  1553. my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds );
  1554.  
  1555. my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
  1556. logger "Running rsync update: /usr/bin/rsync --archive --compress --copy-links --update --verbose rsync://$url '$home_path'";
  1557. system($screen_cmd);
  1558.  
  1559. chdir AGENT_RUN_DIR;
  1560. return 1;
  1561. }
  1562.  
  1563. ### @return PID of the download process if started succesfully.
  1564. ### @return -1 If could not create temporary download directory.
  1565. ### @return -2 If could not create destination directory.
  1566. ### @return -3 If resources unavailable.
  1567. sub master_server_update
  1568. {
  1569. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1570. my ($home_id,$home_path,$ms_home_id,$ms_home_path,$exec_folder_path,$exec_path,$precmd,$postcmd) = decrypt_params(@_);
  1571.  
  1572. if ( check_b4_chdir($home_path) != 0)
  1573. {
  1574. return 0;
  1575. }
  1576.  
  1577. my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
  1578.  
  1579. if ( check_b4_chdir($bash_scripts_path) != 0)
  1580. {
  1581. return 0;
  1582. }
  1583.  
  1584. my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
  1585.  
  1586. my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
  1587.  
  1588. backup_home_log( $home_id, $log_file );
  1589.  
  1590. my $my_home_path = $home_path;
  1591. $my_home_path =~ s/('+)/'\"$1\"'/g;
  1592. $ms_home_path =~ s/('+)/'\"$1\"'/g;
  1593.  
  1594. my @installcmds = ("cp -vuRf '$ms_home_path'/* '$my_home_path'");
  1595. my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd, @installcmds );
  1596.  
  1597. my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
  1598. logger "Running master server update from home ID $home_id to home ID $ms_home_id";
  1599. system($screen_cmd);
  1600.  
  1601. chdir AGENT_RUN_DIR;
  1602. return 1;
  1603. }
  1604.  
  1605. #### Run the steam client ####
  1606. ### @return 1 If update started
  1607. ### @return 0 In error case.
  1608. sub steam_cmd
  1609. {
  1610. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1611. my ($home_id, $home_path, $mod, $modname, $betaname, $betapwd, $user, $pass, $guard, $exec_folder_path, $exec_path, $precmd, $postcmd, $cfg_os) = decrypt_params(@_);
  1612.  
  1613. # Creates home path if it doesn't exist
  1614. if ( check_b4_chdir($home_path) != 0)
  1615. {
  1616. return 0;
  1617. }
  1618.  
  1619. # Changes into root steamcmd OGP directory
  1620. if ( check_b4_chdir(STEAMCMD_CLIENT_DIR) != 0)
  1621. {
  1622. return 0;
  1623. }
  1624.  
  1625. my $screen_id = create_screen_id(SCREEN_TYPE_UPDATE, $home_id);
  1626. my $screen_id_for_txt_update = substr ($screen_id, rindex($screen_id, '_') + 1);
  1627. my $steam_binary = Path::Class::File->new(STEAMCMD_CLIENT_DIR, "steamcmd.exe");
  1628. my $installSteamFile = $screen_id_for_txt_update . "_install.txt";
  1629.  
  1630. my $windows_home_path = `cygpath -wa $home_path`;
  1631. chop $windows_home_path;
  1632.  
  1633. my $installtxt = Path::Class::File->new($installSteamFile);
  1634.  
  1635. open FILE, '>', $installtxt;
  1636. print FILE "\@ShutdownOnFailedCommand 1\n";
  1637. print FILE "\@NoPromptForPassword 1\n";
  1638. if($guard ne '')
  1639. {
  1640. print FILE "set_steam_guard_code $guard\n";
  1641. }
  1642. if($user ne '' && $user ne 'anonymous')
  1643. {
  1644. print FILE "login $user $pass\n";
  1645. }
  1646. else
  1647. {
  1648. print FILE "login anonymous\n";
  1649. }
  1650.  
  1651. print FILE "force_install_dir \"$windows_home_path\"\n";
  1652.  
  1653. if($modname ne "")
  1654. {
  1655. print FILE "app_set_config $mod mod $modname\n"
  1656. }
  1657.  
  1658. if($betaname ne "" && $betapwd ne "")
  1659. {
  1660. print FILE "app_update $mod -beta $betaname -betapassword $betapwd\n";
  1661. }
  1662. elsif($betaname ne "" && $betapwd eq "")
  1663. {
  1664. print FILE "app_update $mod -beta $betaname\n";
  1665. }
  1666. else
  1667. {
  1668. print FILE "app_update $mod\n";
  1669. }
  1670.  
  1671. print FILE "exit\n";
  1672. close FILE;
  1673.  
  1674. my $bash_scripts_path = MANUAL_TMP_DIR . "/home_id_" . $home_id;
  1675.  
  1676. if ( check_b4_chdir($bash_scripts_path) != 0)
  1677. {
  1678. return 0;
  1679. }
  1680.  
  1681. my $log_file = Path::Class::File->new(SCREEN_LOGS_DIR, "screenlog.$screen_id");
  1682. backup_home_log( $home_id, $log_file );
  1683.  
  1684. my $postcmd_mod = $postcmd;
  1685. my @installcmds = ("$steam_binary +runscript $installtxt +exit");
  1686. my $installfile = create_bash_scripts( $home_path, $bash_scripts_path, $precmd, $postcmd_mod, @installcmds );
  1687.  
  1688. my $screen_cmd = create_screen_cmd($screen_id, "./$installfile");
  1689. logger "Running steam update: $steam_binary +runscript $installtxt +exit";
  1690. system($screen_cmd);
  1691.  
  1692. return 1;
  1693. }
  1694.  
  1695. sub rsync_progress
  1696. {
  1697. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1698. my ($running_home) = &decrypt_param(@_);
  1699. logger "User requested progress on rsync job on home $running_home.";
  1700. if (-r $running_home)
  1701. {
  1702. $running_home =~ s/('+)/'"$1"'/g;
  1703. my $progress = `du -sk '$running_home'`;
  1704. chomp($progress);
  1705. my ($bytes, $junk) = split(/\s+/, $progress);
  1706. logger("Found $bytes and $junk");
  1707. return $bytes;
  1708. }
  1709. return "0";
  1710. }
  1711.  
  1712. sub is_file_download_in_progress
  1713. {
  1714. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1715. my ($pid) = &decrypt_param(@_);
  1716. logger "User requested if download is in progress with pid $pid.";
  1717. my @pids = `ps -ef`;
  1718. @pids = grep(/$pid/, @pids);
  1719. logger "Number of pids for file download: @pids";
  1720. if (@pids > '0')
  1721. {
  1722. return 1;
  1723. }
  1724. return 0;
  1725. }
  1726.  
  1727. ### \return 1 If file is uncompressed succesfully.
  1728. ### \return 0 If file does not exist.
  1729. ### \return -1 If file could not be uncompressed.
  1730. sub uncompress_file
  1731. {
  1732. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1733. return uncompress_file_without_decrypt(decrypt_params(@_));
  1734. }
  1735.  
  1736. sub uncompress_file_without_decrypt
  1737. {
  1738.  
  1739. # File must include full path.
  1740. my ($file, $destination) = @_;
  1741.  
  1742. logger "Uncompression called for file $file to dir $destination.";
  1743.  
  1744. if (!-e $file)
  1745. {
  1746. logger "File $file could not be found for uncompression.";
  1747. return 0;
  1748. }
  1749.  
  1750. if (!-e $destination)
  1751. {
  1752. mkpath($destination, {error => \my $err});
  1753. if (@$err)
  1754. {
  1755. logger "Failed to create destination dir $destination.";
  1756. return 0;
  1757. }
  1758. }
  1759.  
  1760. my $ae = Archive::Extract->new(archive => $file);
  1761.  
  1762. if (!$ae)
  1763. {
  1764. logger "Could not create archive instance for file $file.";
  1765. return -1;
  1766. }
  1767.  
  1768. my $ok = $ae->extract(to => $destination);
  1769.  
  1770. if (!$ok)
  1771. {
  1772. logger "File $file could not be uncompressed.";
  1773. return -1;
  1774. }
  1775.  
  1776. system("chmod -Rf 755 $destination");
  1777. system("cd $destination && find -iname \\\*.exe -exec chmod -f +x {} \\\;");
  1778. system("cd $destination && find -iname \\\*.bat -exec chmod -f +x {} \\\;");
  1779.  
  1780. logger "File uncompressed/extracted successfully.";
  1781. return 1;
  1782. }
  1783.  
  1784. ### \return 1 If files are compressed succesfully.
  1785. ### \return -1 If files could not be compressed.
  1786. sub compress_files
  1787. {
  1788. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1789. return compress_files_without_decrypt(decrypt_params(@_));
  1790. }
  1791.  
  1792. sub compress_files_without_decrypt
  1793. {
  1794. my ($files,$destination,$archive_name,$archive_type) = @_;
  1795.  
  1796. if (!-e $destination)
  1797. {
  1798. logger "compress_files: Destination path ( $destination ) could not be found.";
  1799. return -1;
  1800. }
  1801.  
  1802. chdir $destination;
  1803. my @items = split /\Q\n/, $files;
  1804. my @inventory;
  1805. if($archive_type eq "zip")
  1806. {
  1807. logger $archive_type." compression called, destination archive is: $destination$archive_name.$archive_type";
  1808. my $zip = Archive::Zip->new();
  1809. foreach my $item (@items) {
  1810. if(-e $item)
  1811. {
  1812. if (-f $item)
  1813. {
  1814. $zip->addFile( $item );
  1815. }
  1816. elsif (-d $item)
  1817. {
  1818. $zip->addTree( $item, $item );
  1819. }
  1820. }
  1821. }
  1822. # Save the file
  1823. unless ( $zip->writeToFileNamed($archive_name.'.zip') == AZ_OK ) {
  1824. logger "Write Error at $destination/$archive_name.$archive_type";
  1825. return -1
  1826. }
  1827. logger $archive_type." archive $destination$archive_name.$archive_type created successfully";
  1828. return 1;
  1829. }
  1830. elsif($archive_type eq "tbz")
  1831. {
  1832. logger $archive_type." compression called, destination archive is: $destination$archive_name.$archive_type";
  1833. my $tar = Archive::Tar->new;
  1834. foreach my $item (@items) {
  1835. if(-e $item)
  1836. {
  1837. if (-f $item)
  1838. {
  1839. $tar->add_files( $item );
  1840. }
  1841. elsif (-d $item)
  1842. {
  1843. @inventory = ();
  1844. find (sub { push @inventory, $File::Find::name }, $item);
  1845. $tar->add_files( @inventory );
  1846. }
  1847. }
  1848. }
  1849. # Save the file
  1850. unless ( $tar->write("$archive_name.$archive_type", COMPRESS_BZIP) ) {
  1851. logger "Write Error at $destination/$archive_name.$archive_type";
  1852. return -1
  1853. }
  1854. logger $archive_type." archive $destination$archive_name.$archive_type created successfully";
  1855. return 1;
  1856. }
  1857. elsif($archive_type eq "tgz")
  1858. {
  1859. logger $archive_type." compression called, destination archive is: $destination$archive_name.$archive_type";
  1860. my $tar = Archive::Tar->new;
  1861. foreach my $item (@items) {
  1862. if(-e $item)
  1863. {
  1864. if (-f $item)
  1865. {
  1866. $tar->add_files( $item );
  1867. }
  1868. elsif (-d $item)
  1869. {
  1870. @inventory = ();
  1871. find (sub { push @inventory, $File::Find::name }, $item);
  1872. $tar->add_files( @inventory );
  1873. }
  1874. }
  1875. }
  1876. # Save the file
  1877. unless ( $tar->write("$archive_name.$archive_type", COMPRESS_GZIP) ) {
  1878. logger "Write Error at $destination/$archive_name.$archive_type";
  1879. return -1
  1880. }
  1881. logger $archive_type." archive $destination$archive_name.$archive_type created successfully";
  1882. return 1;
  1883. }
  1884. elsif($archive_type eq "tar")
  1885. {
  1886. logger $archive_type." compression called, destination archive is: $destination$archive_name.$archive_type";
  1887. my $tar = Archive::Tar->new;
  1888. foreach my $item (@items) {
  1889. if(-e $item)
  1890. {
  1891. if (-f $item)
  1892. {
  1893. $tar->add_files( $item );
  1894. }
  1895. elsif (-d $item)
  1896. {
  1897. @inventory = ();
  1898. find (sub { push @inventory, $File::Find::name }, $item);
  1899. $tar->add_files( @inventory );
  1900. }
  1901. }
  1902. }
  1903. # Save the file
  1904. unless ( $tar->write("$archive_name.$archive_type") ) {
  1905. logger "Write Error at $destination/$archive_name.$archive_type";
  1906. return -1
  1907. }
  1908. logger $archive_type." archive $destination$archive_name.$archive_type created successfully";
  1909. return 1;
  1910. }
  1911. elsif($archive_type eq "bz2")
  1912. {
  1913. logger $archive_type." compression called.";
  1914. foreach my $item (@items) {
  1915. if(-e $item)
  1916. {
  1917. if (-f $item)
  1918. {
  1919. bzip2 $item => "$item.bz2";
  1920. }
  1921. elsif (-d $item)
  1922. {
  1923. @inventory = ();
  1924. find (sub { push @inventory, $File::Find::name }, $item);
  1925. foreach my $relative_item (@inventory) {
  1926. bzip2 $relative_item => "$relative_item.bz2";
  1927. }
  1928. }
  1929. }
  1930. }
  1931. logger $archive_type." archives created successfully at $destination";
  1932. return 1;
  1933. }
  1934. }
  1935.  
  1936. sub discover_ips
  1937. {
  1938. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1939. my ($check) = decrypt_params(@_);
  1940.  
  1941. if ($check ne "chk")
  1942. {
  1943. logger "Invalid parameter '$check' given for discover_ips function.";
  1944. return "";
  1945. }
  1946.  
  1947. my $iplist = "";
  1948.  
  1949. my @data = `ipconfig /all`;
  1950.  
  1951. foreach my $temp (@data)
  1952. {
  1953. if ($temp =~ /ip.+: (\d+\.\d+\.\d+\.\d+)/si)
  1954. {
  1955. chomp $1;
  1956. logger "Found an IP $1";
  1957. $iplist .= "$1,";
  1958. }
  1959. }
  1960. logger "IPlist is $iplist";
  1961. chop $iplist;
  1962. return "$iplist";
  1963. }
  1964.  
  1965. ### Return -1 In case of invalid param
  1966. ### Return 1;content in case of success
  1967. sub mon_stats
  1968. {
  1969. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1970. my ($mon_stats) = decrypt_params(@_);
  1971. if ($mon_stats ne "mon_stats")
  1972. {
  1973. logger "Invalid parameter '$mon_stats' given for $mon_stats function.";
  1974. return -1;
  1975. }
  1976.  
  1977. my @disk = `df -hP -x tmpfs`;
  1978. my $encoded_content = encode_list(@disk);
  1979. my @uptime = `net stats srv`;
  1980. $encoded_content .= encode_list(@uptime);
  1981. return "1;$encoded_content";
  1982. }
  1983.  
  1984. sub exec
  1985. {
  1986. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1987. my ($command) = decrypt_params(@_);
  1988. my @cmdret = `$command 2>/dev/null`;
  1989. my $encoded_content = encode_list(@cmdret);
  1990. return "1;$encoded_content";
  1991. }
  1992.  
  1993. # used in conjunction with the clone_home feature in the web panel
  1994. # this actually does the file copies
  1995. sub clone_home
  1996. {
  1997. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  1998. my ($source_home, $dest_home, $owner) = decrypt_params(@_);
  1999. my ($time_start, $time_stop, $time_diff);
  2000. logger "Copying from $source_home to $dest_home...";
  2001.  
  2002. # check size of source_home, make sure we have space to copy
  2003. if (!-e $source_home)
  2004. {
  2005. logger "ERROR - $source_home does not exist";
  2006. return 0;
  2007. }
  2008. logger "Game home $source_home exists...copy will proceed";
  2009.  
  2010. # start the copy, and a timer
  2011. $time_start = time();
  2012. if (!dircopy("$source_home", "$dest_home"))
  2013. {
  2014. $time_stop = time();
  2015. $time_diff = $time_stop - $time_start;
  2016. logger
  2017. "Error occured after $time_diff seconds during copy of $source_home to $dest_home - $!";
  2018. return 0;
  2019. }
  2020. else
  2021. {
  2022. $time_stop = time();
  2023. $time_diff = $time_stop - $time_start;
  2024. logger
  2025. "Home clone completed successfully to $dest_home in $time_diff seconds";
  2026. return 1;
  2027. }
  2028. }
  2029.  
  2030. # used to delete the game home from the file system when it's removed from the panel
  2031. sub remove_home
  2032. {
  2033. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2034. my ($home_path_del) = decrypt_params(@_);
  2035.  
  2036. if (!-e $home_path_del)
  2037. {
  2038. logger "ERROR - $home_path_del does not exist...nothing to do";
  2039. return 0;
  2040. }
  2041.  
  2042. sleep 1 while ( !pathrmdir("$home_path_del") );
  2043.  
  2044. logger "Deletetion of $home_path_del successful!";
  2045. return 1;
  2046. }
  2047.  
  2048. sub restart_server
  2049. {
  2050. chomp(@_);
  2051. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2052. return restart_server_without_decrypt(decrypt_params(@_));
  2053. }
  2054.  
  2055. ### Restart the server
  2056. ## return -2 CANT STOP
  2057. ## return -1 CANT START (no startup file found that mach the home_id, port and ip)
  2058. ## return 1 Restart OK
  2059. sub restart_server_without_decrypt
  2060. {
  2061. my ($home_id, $server_ip, $server_port, $control_protocol,
  2062. $control_password, $control_type, $home_path, $server_exe, $run_dir,
  2063. $cmd, $cpu, $nice) = @_;
  2064.  
  2065. if (stop_server_without_decrypt($home_id, $server_ip,
  2066. $server_port, $control_protocol,
  2067. $control_password, $control_type, $home_path) == 0)
  2068. {
  2069. if (universal_start_without_decrypt($home_id, $home_path, $server_exe, $run_dir,
  2070. $cmd, $server_port, $server_ip, $cpu, $nice) == 1)
  2071. {
  2072. return 1;
  2073. }
  2074. else
  2075. {
  2076. return -1;
  2077. }
  2078. }
  2079. else
  2080. {
  2081. return -2;
  2082. }
  2083. }
  2084.  
  2085. sub sudo_exec
  2086. {
  2087. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2088. my $sudo_exec = &decrypt_param(@_);
  2089. return sudo_exec_without_decrypt($sudo_exec);
  2090. }
  2091.  
  2092. sub sudo_exec_without_decrypt
  2093. {
  2094. my ($command) = @_;
  2095. my @cmdret = `$command`;
  2096. if ($? == 0)
  2097. {
  2098. return "1;".encode_list(@cmdret);
  2099. }
  2100. return 0;
  2101. }
  2102.  
  2103. sub secure_path
  2104. {
  2105. return "1;";
  2106. }
  2107.  
  2108. sub get_chattr
  2109. {
  2110. return "1;";
  2111. }
  2112.  
  2113. sub ftp_mgr
  2114. {
  2115. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2116. my ($action, $login, $password, $home_path) = decrypt_params(@_);
  2117.  
  2118. if(!defined($Cfg::Preferences{ogp_manages_ftp}) || (defined($Cfg::Preferences{ogp_manages_ftp}) && $Cfg::Preferences{ogp_manages_ftp} eq "1")){
  2119. if( defined($Cfg::Preferences{ftp_method}) && $Cfg::Preferences{ftp_method} eq "FZ")
  2120. {
  2121. require Cfg::FileZilla; # Use Filezilla Configuration file
  2122. if( !defined($Cfg::FileZilla{fz_exe}) || !defined($Cfg::FileZilla{fz_xml}) || !-e "$Cfg::FileZilla{fz_exe}" || !-e "$Cfg::FileZilla{fz_xml}" )
  2123. {
  2124. return 0;
  2125. }
  2126. use Digest::MD5 qw(md5_hex);
  2127. require XML::Simple;
  2128.  
  2129. my $xml = new XML::Simple;
  2130. my $data = $xml->XMLin( $Cfg::FileZilla{fz_xml},
  2131. ForceArray => ['User','Permission','IpFilter','Allowed','Disallowed','IP','Item'],
  2132. ForceContent => 0,
  2133. KeepRoot => 1,
  2134. KeyAttr => ['Item'],
  2135. SuppressEmpty => 0 );
  2136.  
  2137. my @users;
  2138. if( defined($data->{'FileZillaServer'}->{'Users'}) )
  2139. {
  2140. @users = @{ $data->{'FileZillaServer'}->{'Users'}->{'User'} };
  2141. }
  2142. my $encoded_content;
  2143.  
  2144. if($action eq "list")
  2145. {
  2146. if( grep {defined($_)} @users )
  2147. {
  2148. my (@list,$username,$dir);
  2149. my $i=0;
  2150. for (@users) {
  2151. $username = $_->{'Name'};
  2152. $dir = $_->{'Permissions'}->{'Permission'}[0]->{'Dir'};
  2153. $dir = `cygpath -u "$dir"`;
  2154. $list[$i++] = $username."\t".$dir."\n";
  2155. }
  2156. $encoded_content = encode_list(@list);
  2157. return "1;$encoded_content";
  2158. }
  2159. }
  2160. elsif($action eq "userdel")
  2161. {
  2162. if( grep {defined($_)} @users )
  2163. {
  2164. for (keys @users) {
  2165. if($users[$_]->{'Name'} eq $login)
  2166. {
  2167. splice($data->{'FileZillaServer'}->{'Users'}->{'User'},$_,1);
  2168. last;
  2169. }
  2170. }
  2171.  
  2172. $xml->XMLout( $data,
  2173. OutputFile => $Cfg::FileZilla{fz_xml},
  2174. KeepRoot => 1,
  2175. NoSort => 0,
  2176. SuppressEmpty => 0 );
  2177.  
  2178. my @args = ($Cfg::FileZilla{fz_exe}, "/reload-config");
  2179. system(@args);
  2180. }
  2181. }
  2182. elsif($action eq "useradd")
  2183. {
  2184. my $win_home_path = `cygpath -wa "$home_path"`;
  2185. chomp $win_home_path;
  2186. my $n;
  2187.  
  2188. if( grep {defined($_)} @users )
  2189. {
  2190. $n = scalar(@users);
  2191. }
  2192. else
  2193. {
  2194. $n = 0;
  2195. }
  2196.  
  2197. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Name'} = $login;
  2198. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[0]->{'content'} = md5_hex($password);
  2199. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[0]->{'Name'} = 'Pass';
  2200. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[1]->{'Name'} = 'Group';
  2201. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[2]->{'content'} = '0';
  2202. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[2]->{'Name'} = 'Bypass server userlimit';
  2203. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[3]->{'content'} = '0';
  2204. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[3]->{'Name'} = 'User Limit';
  2205. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[4]->{'content'} = '0';
  2206. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[4]->{'Name'} = 'IP Limit';
  2207. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[5]->{'content'} = '1';
  2208. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[5]->{'Name'} = 'Enabled';
  2209. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[6]->{'Name'} = 'Comments';
  2210. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[7]->{'content'} = '0';
  2211. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[7]->{'Name'} = 'ForceSsl';
  2212. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[8]->{'content'} = '0';
  2213. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[8]->{'Name'} = '8plus3';
  2214. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'IpFilter'}[0]->{'Disallowed'}[0] = undef;
  2215. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'IpFilter'}[0]->{'Allowed'}[0] = undef;
  2216. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[0]->{'content'} = '1';
  2217. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[0]->{'Name'} = 'FileRead';
  2218. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[1]->{'content'} = '1';
  2219. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[1]->{'Name'} = 'FileWrite';
  2220. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[2]->{'content'} = '1';
  2221. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[2]->{'Name'} = 'FileDelete';
  2222. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[3]->{'content'} = '1';
  2223. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[3]->{'Name'} = 'FileAppend';
  2224. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[4]->{'content'} = '1';
  2225. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[4]->{'Name'} = 'DirCreate';
  2226. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[5]->{'content'} = '1';
  2227. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[5]->{'Name'} = 'DirDelete';
  2228. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[6]->{'content'} = '1';
  2229. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[6]->{'Name'} = 'DirList';
  2230. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[7]->{'content'} = '1';
  2231. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[7]->{'Name'} = 'DirSubdirs';
  2232. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[8]->{'content'} = '1';
  2233. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[8]->{'Name'} = 'IsHome';
  2234. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[9]->{'content'} = '1';
  2235. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[9]->{'Name'} = 'AutoCreate';
  2236. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Dir'} = $win_home_path;
  2237. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'DlType'} = '0';
  2238. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'DlLimit'} = '100';
  2239. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'ServerDlLimitBypass'} = '0';
  2240. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'UlType'} = '0';
  2241. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'UlLimit'} = '100';
  2242. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'ServerUlLimitBypass'} = '0';
  2243. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'Upload'}[0] = undef;
  2244. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'Download'}[0] = undef;
  2245.  
  2246. $xml->XMLout( $data,
  2247. OutputFile => $Cfg::FileZilla{fz_xml},
  2248. KeepRoot => 1,
  2249. NoSort => 0,
  2250. SuppressEmpty => 0 );
  2251.  
  2252. my @args = ($Cfg::FileZilla{fz_exe}, "/reload-config");
  2253. system(@args);
  2254. }
  2255. elsif($action eq "passwd")
  2256. {
  2257. if( grep {defined($_)} @users )
  2258. {
  2259. for (keys @users) {
  2260. if($users[$_]->{'Name'} eq $login)
  2261. {
  2262. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$_]->{'Option'}[0]->{'content'} = md5_hex($password);
  2263. last;
  2264. }
  2265. }
  2266. $xml->XMLout( $data,
  2267. OutputFile => $Cfg::FileZilla{fz_xml},
  2268. KeepRoot => 1,
  2269. NoSort => 0,
  2270. SuppressEmpty => 0 );
  2271.  
  2272. my @args = ($Cfg::FileZilla{fz_exe}, "/reload-config");
  2273. system(@args);
  2274. }
  2275. }
  2276. elsif($action eq "show")
  2277. {
  2278. if( grep {defined($_)} @users )
  2279. {
  2280. my (@list,@options,@dir_options,$speed_limmits);
  2281. for (@users) {
  2282. if($login eq $_->{'Name'})
  2283. {
  2284. no warnings 'uninitialized';
  2285. my $i=0;
  2286. $speed_limmits = $_->{'SpeedLimits'};
  2287. while ( my ($key, $value) = each(%$speed_limmits) )
  2288. {
  2289. next if $key =~ /Download|Upload/;
  2290. $list[$i++] = $key." : ".$value."\n";
  2291. }
  2292. @options = @{ $_->{'Option'} };
  2293. for(@options)
  2294. {
  2295. next if $_->{'Name'} eq "Pass";
  2296. $list[$i++] = $_->{'Name'}." : ".$_->{'content'}."\n";
  2297. }
  2298. @dir_options = @{ $_->{'Permissions'}->{'Permission'}[0]->{'Option'} };
  2299. for(@dir_options)
  2300. {
  2301. $list[$i++] = $_->{'Name'}." : ".$_->{'content'}."\n";
  2302. }
  2303. last;
  2304. }
  2305. }
  2306. $encoded_content = encode_list(@list);
  2307. return "1;$encoded_content";
  2308. }
  2309. }
  2310. elsif($action eq "usermod")
  2311. {
  2312. if( grep {defined($_)} @users )
  2313. {
  2314. my $n;
  2315. for (keys @users) {
  2316. if($users[$_]->{'Name'} eq $login)
  2317. {
  2318. $n = $_;
  2319. last;
  2320. }
  2321. }
  2322.  
  2323. if( defined($n) )
  2324. {
  2325. my @account_settings = split /[\n]+/, $password;
  2326. foreach my $setting (@account_settings) {
  2327. my ($key, $value) = split /[\t]+/, $setting;
  2328. if( $value ne "" && $value =~ /^\d+?$/)
  2329. {
  2330. if( $key eq 'DlType' && $value =~ /^[0-3]$/ )
  2331. {
  2332. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'DlType'} = $value;
  2333. }
  2334. elsif( $key eq 'UlType' )
  2335. {
  2336. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'UlType'} = $value;
  2337. }
  2338.  
  2339. if( $value =~ /^[0-1]$/ )
  2340. {
  2341. if( $key eq 'ServerUlLimitBypass' )
  2342. {
  2343. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'ServerUlLimitBypass'} = $value;
  2344. }
  2345. elsif( $key eq 'ServerDlLimitBypass' )
  2346. {
  2347. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'ServerDlLimitBypass'} = $value;
  2348. }
  2349. elsif( $key eq 'Bypass_server_userlimit' )
  2350. {
  2351. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[2]->{'content'} = $value;
  2352. }
  2353. elsif( $key eq 'Enabled' )
  2354. {
  2355. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[5]->{'content'} = $value;
  2356. }
  2357. elsif( $key eq 'ForceSsl' )
  2358. {
  2359. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[7]->{'content'} = $value;
  2360. }
  2361. elsif( $key eq '8plus3' )
  2362. {
  2363. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[8]->{'content'} = $value;
  2364. }
  2365. elsif( $key eq 'FileRead' )
  2366. {
  2367. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[0]->{'content'} = $value;
  2368. }
  2369. elsif( $key eq 'FileWrite' )
  2370. {
  2371. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[1]->{'content'} = $value;
  2372. }
  2373. elsif( $key eq 'FileDelete' )
  2374. {
  2375. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[2]->{'content'} = $value;
  2376. }
  2377. elsif( $key eq 'FileAppend' )
  2378. {
  2379. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[3]->{'content'} = $value;
  2380. }
  2381. elsif( $key eq 'DirCreate' )
  2382. {
  2383. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[4]->{'content'} = $value;
  2384. }
  2385. elsif( $key eq 'DirDelete' )
  2386. {
  2387. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[5]->{'content'} = $value;
  2388. }
  2389. elsif( $key eq 'DirList' )
  2390. {
  2391. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[6]->{'content'} = $value;
  2392. }
  2393. elsif( $key eq 'DirSubdirs' )
  2394. {
  2395. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[7]->{'content'} = $value;
  2396. }
  2397. elsif( $key eq 'IsHome' )
  2398. {
  2399. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[8]->{'content'} = $value;
  2400. }
  2401. elsif( $key eq 'AutoCreate' )
  2402. {
  2403. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Permissions'}->{'Permission'}[0]->{'Option'}[9]->{'content'} = $value;
  2404. }
  2405. }
  2406.  
  2407. if( $value =~ /^[1-9][0-9]{0,8}$|^1000000000$/ )
  2408. {
  2409. if( $key eq 'DlLimit' )
  2410. {
  2411. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'DlLimit'} = $value;
  2412. }
  2413. elsif( $key eq 'UlLimit' )
  2414. {
  2415. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'SpeedLimits'}->{'UlLimit'} = $value;
  2416. }
  2417. }
  2418.  
  2419. if( $key eq 'User_Limit' )
  2420. {
  2421. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[3]->{'content'} = $value;
  2422. }
  2423. elsif( $key eq 'IP_Limit' )
  2424. {
  2425. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[4]->{'content'} = $value;
  2426. }
  2427. }
  2428.  
  2429. if( $key eq 'Comments' )
  2430. {
  2431. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[6]->{'content'} = $value;
  2432. }
  2433. elsif( $key eq 'Group' )
  2434. {
  2435. $data->{'FileZillaServer'}->{'Users'}->{'User'}[$n]->{'Option'}[1]->{'content'} = $value;
  2436. }
  2437. }
  2438. }
  2439. $xml->XMLout( $data,
  2440. OutputFile => $Cfg::FileZilla{fz_xml},
  2441. KeepRoot => 1,
  2442. NoSort => 0,
  2443. SuppressEmpty => 0 );
  2444.  
  2445. my @args = ($Cfg::FileZilla{fz_exe}, "/reload-config");
  2446. system(@args);
  2447. }
  2448. }
  2449. return 1;
  2450. }
  2451. elsif( defined($Cfg::Preferences{ftp_method}) && $Cfg::Preferences{ftp_method} eq "PureFTPd")
  2452. {
  2453. my $uid = `id -u`;
  2454. chomp $uid;
  2455. my $gid = `id -g`;
  2456. chomp $gid;
  2457.  
  2458. $login =~ s/('+)/'\"$1\"'/g;
  2459. $password =~ s/('+)/'\"$1\"'/g;
  2460. $home_path =~ s/('+)/'\"$1\"'/g;
  2461.  
  2462. if($action eq "list")
  2463. {
  2464. return sudo_exec_without_decrypt("pure-pw list");
  2465. }
  2466. elsif($action eq "userdel")
  2467. {
  2468. return sudo_exec_without_decrypt("pure-pw userdel '$login' && pure-pw mkdb");
  2469. }
  2470. elsif($action eq "useradd")
  2471. {
  2472. return sudo_exec_without_decrypt("(echo '$password'; echo '$password') | pure-pw useradd '$login' -u $uid -g $gid -d '$home_path' && pure-pw mkdb");
  2473. }
  2474. elsif($action eq "passwd")
  2475. {
  2476. return sudo_exec_without_decrypt("(echo '$password'; echo '$password') | pure-pw passwd '$login' && pure-pw mkdb");
  2477. }
  2478. elsif($action eq "show")
  2479. {
  2480. return sudo_exec_without_decrypt("pure-pw show '$login'");
  2481. }
  2482. elsif($action eq "usermod")
  2483. {
  2484. my $update_account = "pure-pw usermod '$login' -u $uid -g $gid";
  2485.  
  2486. my @account_settings = split /[\n]+/, $password;
  2487.  
  2488. foreach my $setting (@account_settings) {
  2489. my ($key, $value) = split /[\t]+/, $setting;
  2490.  
  2491. if( $key eq 'Directory' )
  2492. {
  2493. $value =~ s/('+)/'\"$1\"'/g;
  2494. $update_account .= " -d '$value'";
  2495. }
  2496.  
  2497. if( $key eq 'Full_name' )
  2498. {
  2499. if( $value ne "" )
  2500. {
  2501. $value =~ s/('+)/'\"$1\"'/g;
  2502. $update_account .= " -c '$value'";
  2503. }
  2504. else
  2505. {
  2506. $update_account .= ' -c ""';
  2507. }
  2508. }
  2509.  
  2510. if( $key eq 'Download_bandwidth' && $value ne "" )
  2511. {
  2512. my $Download_bandwidth;
  2513. if($value eq 0)
  2514. {
  2515. $Download_bandwidth = "\"\"";
  2516. }
  2517. else
  2518. {
  2519. $Download_bandwidth = $value;
  2520. }
  2521. $update_account .= " -t " . $Download_bandwidth;
  2522. }
  2523.  
  2524. if( $key eq 'Upload___bandwidth' && $value ne "" )
  2525. {
  2526. my $Upload___bandwidth;
  2527. if($value eq 0)
  2528. {
  2529. $Upload___bandwidth = "\"\"";
  2530. }
  2531. else
  2532. {
  2533. $Upload___bandwidth = $value;
  2534. }
  2535. $update_account .= " -T " . $Upload___bandwidth;
  2536. }
  2537.  
  2538. if( $key eq 'Max_files' )
  2539. {
  2540. if( $value eq "0" )
  2541. {
  2542. $update_account .= ' -n ""';
  2543. }
  2544. elsif( $value ne "" )
  2545. {
  2546. $update_account .= " -n " . $value;
  2547. }
  2548. else
  2549. {
  2550. $update_account .= ' -n ""';
  2551. }
  2552. }
  2553.  
  2554. if( $key eq 'Max_size' )
  2555. {
  2556. if( $value ne "" )
  2557. {
  2558. $update_account .= " -N " . $value;
  2559. }
  2560. else
  2561. {
  2562. $update_account .= ' -N ""';
  2563. }
  2564. }
  2565.  
  2566. if( $key eq 'Ratio' && $value ne "" )
  2567. {
  2568. my($upload_ratio,$download_ratio) = split/:/,$value;
  2569.  
  2570. if($upload_ratio eq "0")
  2571. {
  2572. $upload_ratio = "\"\"";
  2573. }
  2574. $update_account .= " -q " . $upload_ratio;
  2575.  
  2576. if($download_ratio eq "0")
  2577. {
  2578. $download_ratio = "\"\"";
  2579. }
  2580. $update_account .= " -Q " . $download_ratio;
  2581. }
  2582.  
  2583. if( $key eq 'Allowed_client_IPs' )
  2584. {
  2585. if( $value ne "" )
  2586. {
  2587. $update_account .= " -r " . $value;
  2588. }
  2589. else
  2590. {
  2591. $update_account .= ' -r ""';
  2592. }
  2593. }
  2594.  
  2595. if( $key eq 'Denied__client_IPs' )
  2596. {
  2597. if( $value ne "" )
  2598. {
  2599. $update_account .= " -R " . $value;
  2600. }
  2601. else
  2602. {
  2603. $update_account .= ' -R ""';
  2604. }
  2605. }
  2606.  
  2607. if( $key eq 'Allowed_local__IPs' )
  2608. {
  2609. if( $value ne "" )
  2610. {
  2611. $update_account .= " -i " . $value;
  2612. }
  2613. else
  2614. {
  2615. $update_account .= ' -i ""';
  2616. }
  2617. }
  2618.  
  2619. if( $key eq 'Denied__local__IPs' )
  2620. {
  2621. if( $value ne "" )
  2622. {
  2623. $update_account .= " -I " . $value;
  2624. }
  2625. else
  2626. {
  2627. $update_account .= ' -I ""';
  2628. }
  2629. }
  2630.  
  2631.  
  2632. if( $key eq 'Max_sim_sessions' && $value ne "" )
  2633. {
  2634. $update_account .= " -y " . $value;
  2635. }
  2636.  
  2637. if ( $key eq 'Time_restrictions' )
  2638. {
  2639. if( $value eq "0000-0000")
  2640. {
  2641. $update_account .= ' -z ""';
  2642. }
  2643. elsif( $value ne "" )
  2644. {
  2645. $update_account .= " -z " . $value;
  2646. }
  2647. else
  2648. {
  2649. $update_account .= ' -z ""';
  2650. }
  2651. }
  2652. }
  2653. $update_account .=" && pure-pw mkdb";
  2654. # print $update_account;
  2655. return sudo_exec_without_decrypt($update_account);
  2656. }
  2657. }
  2658. }
  2659. return 0;
  2660. }
  2661.  
  2662. sub start_fastdl
  2663. {
  2664. if(-e Path::Class::File->new(FD_DIR, 'Settings.pm'))
  2665. {
  2666. system('CYGWIN="${CYGWIN} nodosfilewarning"; export CYGWIN; perl FastDownload/ForkedDaemon.pm &');
  2667. sleep(1);
  2668. return 1;
  2669. }
  2670. else
  2671. {
  2672. return -2;
  2673. }
  2674. }
  2675.  
  2676. sub stop_fastdl
  2677. {
  2678. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2679. return stop_fastdl_without_decrypt();
  2680. }
  2681.  
  2682. sub stop_fastdl_without_decrypt
  2683. {
  2684. my $pid;
  2685. open(PIDFILE, '<', FD_PID_FILE)
  2686. || logger "Error reading pid file $!",1;
  2687. while (<PIDFILE>)
  2688. {
  2689. $pid = $_;
  2690. chomp $pid;
  2691. }
  2692. close(PIDFILE);
  2693. my $cnt = kill 9, $pid;
  2694. if ($cnt == 1)
  2695. {
  2696. logger "Fast Download Daemon Stopped.",1;
  2697. return 1;
  2698. }
  2699. else
  2700. {
  2701. logger "Fast Download Daemon with pid $pid can not be stopped.",1;
  2702. return -1;
  2703. }
  2704. }
  2705.  
  2706. sub restart_fastdl
  2707. {
  2708. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2709. return restart_fastdl_without_decrypt();
  2710. }
  2711.  
  2712. sub restart_fastdl_without_decrypt
  2713. {
  2714. if((fastdl_status_without_decrypt() == -1) || (stop_fastdl_without_decrypt() == 1))
  2715. {
  2716. if(start_fastdl() == 1)
  2717. {
  2718. # Success
  2719. return 1;
  2720. }
  2721. # Cant start
  2722. return -2;
  2723. }
  2724. # Cant stop
  2725. return -3;
  2726. }
  2727.  
  2728. sub fastdl_status
  2729. {
  2730. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2731. return fastdl_status_without_decrypt();
  2732. }
  2733.  
  2734. sub fastdl_status_without_decrypt
  2735. {
  2736. my $pid;
  2737. if(!open(PIDFILE, '<', FD_PID_FILE))
  2738. {
  2739. logger "Error reading pid file $!";
  2740. return -1;
  2741. }
  2742. while (<PIDFILE>)
  2743. {
  2744. $pid = $_;
  2745. chomp $pid;
  2746. }
  2747. close(PIDFILE);
  2748. my $cnt = kill 0, $pid;
  2749. if ($cnt == 1)
  2750. {
  2751. return 1;
  2752. }
  2753. else
  2754. {
  2755. return -1;
  2756. }
  2757. }
  2758.  
  2759. sub fastdl_get_aliases
  2760. {
  2761. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2762. my %aliases;
  2763. my $i;
  2764. my @file_lines;
  2765. if(-d FD_ALIASES_DIR)
  2766. {
  2767. if( !opendir(ALIASES, FD_ALIASES_DIR) )
  2768. {
  2769. logger "Error openning aliases directory " . FD_ALIASES_DIR . ", $!";
  2770. }
  2771. else
  2772. {
  2773. while (my $alias = readdir(ALIASES))
  2774. {
  2775. # Skip . and ..
  2776. next if $alias =~ /^\./;
  2777. if( !open(ALIAS, '<', Path::Class::Dir->new(FD_ALIASES_DIR, $alias)) )
  2778. {
  2779. logger "Error reading alias '$alias', $!";
  2780. }
  2781. else
  2782. {
  2783. $i = 0;
  2784. @file_lines = ();
  2785. while (<ALIAS>)
  2786. {
  2787. chomp $_;
  2788. $file_lines[$i] = $_;
  2789. $i++;
  2790. }
  2791. close(ALIAS);
  2792. $aliases{$alias}{home} = $file_lines[0];
  2793. $aliases{$alias}{match_file_extension} = $file_lines[1];
  2794. $aliases{$alias}{match_client_ip} = $file_lines[2];
  2795. }
  2796. }
  2797. closedir(ALIASES);
  2798. }
  2799. }
  2800. else
  2801. {
  2802. logger "Aliases directory '" . FD_ALIASES_DIR . "' does not exist or is inaccessible.";
  2803. }
  2804. return {%aliases};
  2805. }
  2806.  
  2807. sub fastdl_del_alias
  2808. {
  2809. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2810. foreach my $alias (decrypt_params(@_))
  2811. {
  2812. unlink Path::Class::File->new(FD_ALIASES_DIR, $alias);
  2813. }
  2814. return restart_fastdl_without_decrypt();
  2815. }
  2816.  
  2817. sub fastdl_add_alias
  2818. {
  2819. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2820. my ($alias,$home,$match_file_extension,$match_client_ip) = decrypt_params(@_);
  2821. if(!-e FD_ALIASES_DIR)
  2822. {
  2823. if(!mkdir FD_ALIASES_DIR)
  2824. {
  2825. logger "ERROR - Failed to create " . FD_ALIASES_DIR . " directory.";
  2826. return -1;
  2827. }
  2828. }
  2829. my $alias_path = Path::Class::File->new(FD_ALIASES_DIR, $alias);
  2830. if (!open(ALIAS, '>', $alias_path))
  2831. {
  2832. logger "ERROR - Failed to open ".$alias_path." for writing.";
  2833. return -1;
  2834. }
  2835. else
  2836. {
  2837. print ALIAS "$home\n";
  2838. print ALIAS "$match_file_extension\n";
  2839. print ALIAS "$match_client_ip";
  2840. close(ALIAS);
  2841. return restart_fastdl_without_decrypt();
  2842. }
  2843. }
  2844.  
  2845. sub fastdl_get_info
  2846. {
  2847. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2848. if(-e Path::Class::File->new(FD_DIR, 'Settings.pm'))
  2849. {
  2850. delete $INC{"FastDownload/Settings.pm"};
  2851. require "FastDownload/Settings.pm"; # Settings for Fast Download Daemon.
  2852. if(not defined $FastDownload::Settings{autostart_on_agent_startup})
  2853. {
  2854. $FastDownload::Settings{autostart_on_agent_startup} = 0;
  2855. }
  2856. return {'port' => $FastDownload::Settings{port},
  2857. 'ip' => $FastDownload::Settings{ip},
  2858. 'listing' => $FastDownload::Settings{listing},
  2859. 'autostart_on_agent_startup'=> $FastDownload::Settings{autostart_on_agent_startup}};
  2860. }
  2861. return -1
  2862. }
  2863.  
  2864. sub fastdl_create_config
  2865. {
  2866. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2867. if(!-e FD_DIR)
  2868. {
  2869. if(!mkdir FD_DIR)
  2870. {
  2871. logger "ERROR - Failed to create " . FD_DIR . " directory.";
  2872. return -1;
  2873. }
  2874. }
  2875. my ($fd_address, $fd_port, $listing, $autostart_on_agent_startup) = decrypt_params(@_);
  2876. my $settings_string = "%FastDownload::Settings = (\n".
  2877. "\tport => $fd_port,\n".
  2878. "\tip => '$fd_address',\n".
  2879. "\tlisting => $listing,\n".
  2880. "\tautostart_on_agent_startup => $autostart_on_agent_startup,\n".
  2881. ");";
  2882. my $settings = Path::Class::File->new(FD_DIR, 'Settings.pm');
  2883. if (!open(SETTINGS, '>', $settings))
  2884. {
  2885. logger "ERROR - Failed to open $settings for writing.";
  2886. return -1;
  2887. }
  2888. else
  2889. {
  2890. print SETTINGS $settings_string;
  2891. close(SETTINGS);
  2892. }
  2893. logger "$settings file written successfully.";
  2894. return 1;
  2895. }
  2896.  
  2897. sub agent_restart
  2898. {
  2899. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  2900. my $dec_check = decrypt_param(@_);
  2901. if ($dec_check eq 'restart')
  2902. {
  2903. chdir AGENT_RUN_DIR;
  2904. if(-e "ogp_agent_run.pid")
  2905. {
  2906. my $init_pid = `cat ogp_agent_run.pid`;
  2907. chomp($init_pid);
  2908.  
  2909. if(kill 0, $init_pid)
  2910. {
  2911. my $or_exist = "";
  2912. my $rm_pid_file = "";
  2913. my $agent_pid = "";
  2914. if(-e "ogp_agent.pid")
  2915. {
  2916. $rm_pid_file .= " ogp_agent.pid";
  2917. $agent_pid = `cat ogp_agent.pid`;
  2918. chomp($agent_pid);
  2919. if( kill 0, $agent_pid )
  2920. {
  2921. $or_exist .= " -o -e /proc/$agent_pid";
  2922. }
  2923. }
  2924.  
  2925. my $pureftpd_pid = "";
  2926. if(-e "/var/run/pure-ftpd.pid")
  2927. {
  2928. $rm_pid_file .= " /var/run/pure-ftpd.pid";
  2929. $pureftpd_pid = `cat /var/run/pure-ftpd.pid`;
  2930. chomp($pureftpd_pid);
  2931. if( kill 0, $pureftpd_pid )
  2932. {
  2933. $or_exist .= " -o -e /proc/$pureftpd_pid";
  2934. }
  2935. }
  2936.  
  2937. open (AGENT_RESTART_SCRIPT, '>', 'tmp_restart.sh');
  2938. my $restart = "echo -n \"Stopping OGP Agent...\"\n".
  2939. "kill $init_pid $agent_pid $pureftpd_pid\n".
  2940. "while [ -e /proc/$init_pid $or_exist ];do echo -n .;sleep 1;done\n".
  2941. "rm -f ogp_agent_run.pid $rm_pid_file\necho \" [OK]\"\n".
  2942. "echo -n \"Starting OGP Agent...\"\n".
  2943. "screen -d -m -t \"ogp_agent\" -c \"" . SCREENRC_FILE . "\" -S ogp_agent bash ogp_agent -pidfile /OGP/ogp_agent_run.pid\n".
  2944. "while [ ! -e 'ogp_agent_run.pid' -o ! -e 'ogp_agent.pid' -o ! -e '/var/run/pure-ftpd.pid' ];do echo -n .;sleep 1;done\n".
  2945. "echo \" [OK]\"\n".
  2946. "rm -f tmp_restart.sh\n".
  2947. "exit 0\n";
  2948. print AGENT_RESTART_SCRIPT $restart;
  2949. close (AGENT_RESTART_SCRIPT);
  2950. if( -e 'tmp_restart.sh' )
  2951. {
  2952. system('screen -d -m -t "agent_restart" -c "' . SCREENRC_FILE . '" -S agent_restart bash tmp_restart.sh');
  2953. }
  2954. }
  2955. }
  2956. }
  2957. return -1;
  2958. }
  2959.  
  2960. # Subroutines to be called
  2961. sub scheduler_dispatcher {
  2962. my ($task, $args) = @_;
  2963. my $response = `$args`;
  2964. chomp($response);
  2965. my $log = "Executed command: $args";
  2966. if($response ne "")
  2967. {
  2968. $log .= ", response:\n$response";
  2969. }
  2970. scheduler_log_events($log);
  2971. }
  2972.  
  2973. sub scheduler_server_action
  2974. {
  2975. my ($task, $args) = @_;
  2976. my ($action, @server_args) = split('\|\%\|', $args);
  2977. if($action eq "%ACTION=start")
  2978. {
  2979. my ($home_id, $ip, $port) = ($server_args[0], $server_args[6], $server_args[5]);
  2980. my $ret = universal_start_without_decrypt(@server_args);
  2981. if($ret == 1)
  2982. {
  2983. scheduler_log_events("Started server home ID $home_id on address $ip:$port");
  2984. }
  2985. else
  2986. {
  2987. scheduler_log_events("Failed starting server home ID $home_id on address $ip:$port (Check agent log)");
  2988. }
  2989. }
  2990. elsif($action eq "%ACTION=stop")
  2991. {
  2992. my ($home_id, $ip, $port) = ($server_args[0], $server_args[1], $server_args[2]);
  2993. my $ret = stop_server_without_decrypt(@server_args);
  2994. if($ret == 0)
  2995. {
  2996. scheduler_log_events("Stopped server home ID $home_id on address $ip:$port");
  2997. }
  2998. elsif($ret == 1)
  2999. {
  3000. scheduler_log_events("Failed stopping server home ID $home_id on address $ip:$port (Invalid IP:Port given)");
  3001. }
  3002. }
  3003. elsif($action eq "%ACTION=restart")
  3004. {
  3005. my ($home_id, $ip, $port) = ($server_args[0], $server_args[1], $server_args[2]);
  3006. my $ret = restart_server_without_decrypt(@server_args);
  3007. if($ret == 1)
  3008. {
  3009. scheduler_log_events("Restarted server home ID $home_id on address $ip:$port");
  3010. }
  3011. elsif($ret == -1)
  3012. {
  3013. scheduler_log_events("Failed restarting server home ID $home_id on address $ip:$port (Server could not be started, check agent log)");
  3014. }
  3015. elsif($ret == -2)
  3016. {
  3017. scheduler_log_events("Failed restarting server home ID $home_id on address $ip:$port (Server could not be stopped, check agent log)");
  3018. }
  3019. }
  3020. return 1;
  3021. }
  3022.  
  3023. sub scheduler_log_events
  3024. {
  3025. my $logcmd = $_[0];
  3026. $logcmd = localtime() . " $logcmd\n";
  3027. logger "Can't open " . SCHED_LOG_FILE . " - $!" unless open(LOGFILE, '>>', SCHED_LOG_FILE);
  3028. logger "Failed to lock " . SCHED_LOG_FILE . "." unless flock(LOGFILE, LOCK_EX);
  3029. logger "Failed to seek to end of " . SCHED_LOG_FILE . "." unless seek(LOGFILE, 0, 2);
  3030. logger "Failed to write to " . SCHED_LOG_FILE . "." unless print LOGFILE "$logcmd";
  3031. logger "Failed to unlock " . SCHED_LOG_FILE . "." unless flock(LOGFILE, LOCK_UN);
  3032. logger "Failed to close " . SCHED_LOG_FILE . "." unless close(LOGFILE);
  3033. }
  3034.  
  3035. sub scheduler_add_task
  3036. {
  3037. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  3038. my $new_task = decrypt_param(@_);
  3039. if (open(TASKS, '>>', SCHED_TASKS))
  3040. {
  3041. print TASKS "$new_task\n";
  3042. logger "Created new task: $new_task";
  3043. close(TASKS);
  3044. scheduler_stop();
  3045. # Create new object with default dispatcher for scheduled tasks
  3046. $cron = new Schedule::Cron( \&scheduler_dispatcher, {
  3047. nofork => 1,
  3048. loglevel => 0,
  3049. log => sub { print $_[1], "\n"; }
  3050. } );
  3051.  
  3052. $cron->add_entry( "* * * * * *", \&scheduler_read_tasks );
  3053. # Run scheduler
  3054. $cron->run( {detach=>1, pid_file=>SCHED_PID} );
  3055. return 1;
  3056. }
  3057. logger "Cannot create task: $new_task ( $! )";
  3058. return -1;
  3059. }
  3060.  
  3061. sub scheduler_del_task
  3062. {
  3063. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  3064. my $name = decrypt_param(@_);
  3065. if( scheduler_read_tasks() == -1 )
  3066. {
  3067. return -1;
  3068. }
  3069. my @entries = $cron->list_entries();
  3070. if(open(TASKS, '>', SCHED_TASKS))
  3071. {
  3072. foreach my $task ( @entries ) {
  3073. next if $task->{args}[0] eq $name;
  3074. next unless $task->{args}[0] =~ /task_[0-9]*/;
  3075. if(defined $task->{args}[1])
  3076. {
  3077. print TASKS join(" ", $task->{time}, $task->{args}[1]) . "\n";
  3078. }
  3079. else
  3080. {
  3081. print TASKS $task->{time} . "\n";
  3082. }
  3083. }
  3084. close( TASKS );
  3085. scheduler_stop();
  3086. # Create new object with default dispatcher for scheduled tasks
  3087. $cron = new Schedule::Cron( \&scheduler_dispatcher, {
  3088. nofork => 1,
  3089. loglevel => 0,
  3090. log => sub { print $_[1], "\n"; }
  3091. } );
  3092.  
  3093. $cron->add_entry( "* * * * * *", \&scheduler_read_tasks );
  3094. # Run scheduler
  3095. $cron->run( {detach=>1, pid_file=>SCHED_PID} );
  3096. return 1;
  3097. }
  3098. logger "Cannot open file " . SCHED_TASKS . " for deleting task id: $name ( $! )",1;
  3099. return -1;
  3100. }
  3101.  
  3102. sub scheduler_edit_task
  3103. {
  3104. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  3105. my ($name, $new_task) = decrypt_params(@_);
  3106. if( scheduler_read_tasks() == -1 )
  3107. {
  3108. return -1;
  3109. }
  3110. my @entries = $cron->list_entries();
  3111. if(open(TASKS, '>', SCHED_TASKS))
  3112. {
  3113. foreach my $task ( @entries ) {
  3114. next unless $task->{args}[0] =~ /task_[0-9]*/;
  3115. if($name eq $task->{args}[0])
  3116. {
  3117. print TASKS "$new_task\n";
  3118. }
  3119. else
  3120. {
  3121. if(defined $task->{args}[1])
  3122. {
  3123. print TASKS join(" ", $task->{time}, $task->{args}[1]) . "\n";
  3124. }
  3125. else
  3126. {
  3127. print TASKS $task->{time} . "\n";
  3128. }
  3129. }
  3130. }
  3131. close( TASKS );
  3132. scheduler_stop();
  3133. # Create new object with default dispatcher for scheduled tasks
  3134. $cron = new Schedule::Cron( \&scheduler_dispatcher, {
  3135. nofork => 1,
  3136. loglevel => 0,
  3137. log => sub { print $_[1], "\n"; }
  3138. } );
  3139.  
  3140. $cron->add_entry( "* * * * * *", \&scheduler_read_tasks );
  3141. # Run scheduler
  3142. $cron->run( {detach=>1, pid_file=>SCHED_PID} );
  3143. return 1;
  3144. }
  3145. logger "Cannot open file " . SCHED_TASKS . " for editing task id: $name ( $! )",1;
  3146. return -1;
  3147. }
  3148.  
  3149. sub scheduler_read_tasks
  3150. {
  3151. if( open(TASKS, '<', SCHED_TASKS) )
  3152. {
  3153. $cron->clean_timetable();
  3154. }
  3155. else
  3156. {
  3157. logger "Error reading tasks file $!";
  3158. scheduler_stop();
  3159. return -1;
  3160. }
  3161.  
  3162. my $i = 0;
  3163. while (<TASKS>)
  3164. {
  3165. next if $_ =~ /^(#.*|[\s|\t]*?\n)/;
  3166. my ($minute, $hour, $dayOfTheMonth, $month, $dayOfTheWeek, @args) = split(' ', $_);
  3167. my $time = "$minute $hour $dayOfTheMonth $month $dayOfTheWeek";
  3168. if("@args" =~ /^\%ACTION.*/)
  3169. {
  3170. $cron->add_entry($time, \&scheduler_server_action, 'task_' . $i++, "@args");
  3171. }
  3172. else
  3173. {
  3174. $cron->add_entry($time, 'task_' . $i++, "@args");
  3175. }
  3176. }
  3177. close(TASKS);
  3178. return 1;
  3179. }
  3180.  
  3181. sub scheduler_stop
  3182. {
  3183. my $pid;
  3184. if(open(PIDFILE, '<', SCHED_PID))
  3185. {
  3186. $pid = <PIDFILE>;
  3187. chomp $pid;
  3188. close(PIDFILE);
  3189. if($pid ne "")
  3190. {
  3191. if( kill 0, $pid )
  3192. {
  3193. my $cnt = kill 9, $pid;
  3194. if ($cnt == 1)
  3195. {
  3196. unlink SCHED_PID;
  3197. return 1;
  3198. }
  3199. }
  3200. }
  3201. }
  3202. return -1;
  3203. }
  3204.  
  3205. sub scheduler_list_tasks
  3206. {
  3207. return "Bad Encryption Key" unless(decrypt_param(pop(@_)) eq "Encryption checking OK");
  3208. if( scheduler_read_tasks() == -1 )
  3209. {
  3210. return -1;
  3211. }
  3212. my @entries = $cron->list_entries();
  3213. my %entries_array;
  3214. foreach my $task ( @entries ) {
  3215. if( defined $task->{args}[1] )
  3216. {
  3217. $entries_array{$task->{args}[0]} = encode_base64(join(" ", $task->{time}, $task->{args}[1]));
  3218. }
  3219. else
  3220. {
  3221. $entries_array{$task->{args}[0]} = encode_base64($task->{time});
  3222. }
  3223. }
  3224. if( %entries_array )
  3225. {
  3226. return {%entries_array};
  3227. }
  3228. return -1;
  3229. }
Add Comment
Please, Sign In to add comment