# adminprotocol-lib.pl # Common functions for talking to the admin module of QTSS #---------------------------------------------------------- # # @APPLE_LICENSE_HEADER_START@ # # # Copyright (c) 1999-2008 Apple Inc. All Rights Reserved. # # This file contains Original Code and/or Modifications of Original Code # as defined in and that are subject to the Apple Public Source License # Version 2.0 (the 'License'). You may not use this file except in # compliance with the License. Please obtain a copy of the License at # http://www.opensource.apple.com/apsl/ and read it before using this # file. # # The Original Code and all software distributed under the License are # distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER # EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, # INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. # Please see the License for the specific language governing rights and # limitations under the License. # # @APPLE_LICENSE_HEADER_END@ # # #--------------------------------------------------------- require ('playlist-lib.pl'); package adminprotolib; # Vital libraries #use IO::Socket; use Socket; @weekdayStr = ( "SunStr", "MonStr", "TueStr", "WedStr", "ThuStr", "FriStr", "SatStr" ); @monthStr = ( "JanStr", "FebStr", "MarStr", "AprStr", "MayStr", "JunStr", "JulStr", "AugStr", "SepStr", "OctStr", "NovStr", "DecStr" ); $enMessageHash = $ENV{"QTSSADMINSERVER_EN_MESSAGEHASH"}; $deMessageHash = $ENV{"QTSSADMINSERVER_EN_MESSAGEHASH"}; $jaMessageHash = $ENV{"QTSSADMINSERVER_EN_MESSAGEHASH"}; $frMessageHash = $ENV{"QTSSADMINSERVER_EN_MESSAGEHASH"}; # GetMessageHash() # Returns the messages hash given the language sub GetMessageHash { return $ENV{"QTSSADMINSERVER_EN_MESSAGEHASH"}; } # GetGenreArray() # Returns the messages hash given the language sub GetGenreArray { my $lang = $ENV{"LANGUAGE"}; @genreArray = (); my $genreFilename = $ENV{'SERVER_ROOT'} . "/html_en/" . $ENV{"GENREFILE"}; open(GENRES, $genreFilename) or die "Couldn't find the $lang genre file $genreFilename!"; while($genreLine = ) { $genreLine =~ s/[\r\n]//g; push(@genreArray, $genreLine); } return \@genreArray; } my $confPath = $ENV{"QTSSADMINSERVER_CONFIG"}; # GetData(data, messageHash, authheader, serverName, port, uri) # Does an HTTP GET to a server and puts the body in a scalar variable # Returns the status code of the response from the server sub GetData { my ($messHash, $authheader, $remote,$port, $iaddr, $paddr, $proto, $uri); $messHash = $_[1]; $authheader = $_[2]; $remote = $_[3]; $port = $_[4]; $uri = $_[5]; my %messages = %$messHash; my $status = 500; if(!($iaddr = inet_aton($remote))) { $_[0] = "$messages{'NoHostError'}: $remote"; return $status; } $paddr = sockaddr_in($port, $iaddr); $proto = getprotobyname('tcp'); if(!socket(CLIENT_SOCK, PF_INET, SOCK_STREAM, $proto)) { $_[0] = "$messages{'SocketFailedError'}: $!"; return $status; } if(!connect(CLIENT_SOCK, $paddr)) { $_[0] = "$messages{'ConnectFailedError'}: $!"; close (CLIENT_SOCK); return $status; } # send request $request = "GET $uri HTTP/1.1\r\nUser-Agent: PerlScript\r\nAccept: */*\r\nConnection: close\r\n" . "$authheader\r\n"; my $bytesSent = 0; while($bytesSent < length($request)) { $partOfRequest = substr($request, $bytesSent); if(!($bytes = send(CLIENT_SOCK, $partOfRequest, 0))) { $_[0] = "$messages{'SendFailedError'}: $!"; close (CLIENT_SOCK); return $status; } $bytesSent += $bytes; } # read response my $partOfResponse; $response = ""; while(1) { $partOfResponse = ""; #if($^O eq "MSWin32") { # ($servipaddr = recv(CLIENT_SOCK, $partOfResponse, 1024, 0)) || last; #} #else { ($numBytesRead = read(CLIENT_SOCK, $partOfResponse, 1024)) || last; #} $response .= $partOfResponse; } # read response headers my @lines = split /\n/m, $response; my $line = shift @lines; # Check the status code of the response if ($line =~ m/^(\S*?)(\s)(.*?)(\s)(\S*?)(\s*)$/) { $status = $3; } # Go through the rest of the headers while(@lines) { $line = shift @lines; if ($line =~ m/^\s*$/) { last; } if($line =~ /^(\S+):\s+(.*)$/) { if(lc($1) eq "www-authenticate") { $challenge = $line; } } } # Read the response body if ($status == 200) { $responseText = ""; while(@lines) { $line = shift @lines; $responseText .= "$line\n"; } $_[0] = $responseText; } elsif ($status == 401) { $_[0] = $challenge; } close (CLIENT_SOCK); return $status; } # EchoData(data, messageHash, authheader, serverName, port, uri, param) # Uses GetData to fetch the uri and parses the value in param=value # into a scalar variable. # Returns the value as a scalar sub EchoData { my $messHash = $_[1]; my $authheader = $_[2]; my $serverName = $_[3]; my $serverPort = $_[4]; my $uri = $_[5]; my $param = $_[6]; my $responseText = ""; my $status = GetData($responseText, $messHash, $authheader, $serverName, $serverPort, $uri); if($status != 200) { $_[0] = $responseText; return $status; } my $paramName = ""; my $paramValue = ""; if ($param =~ m/^(.*)\/(\w+)$/) { $paramName = $2; } else { $paramName = $param; } my @lines = split /\n/, $responseText; my $line; while(@lines) { $line = shift @lines; if($line =~ m/^$paramName=\"(.*)\"(\s*)$/) { $paramValue = $1; } } if($paramValue eq "") { undef($paramValue); } $_[0] = $paramValue; return $status; } # GetMovieDir(dirname, messageHash, authheader, serverName, port) # Uses GetData to fetch the location of the Movies # directory from the QTSS server. # Returns the value as a scalar in the first parameter. # Also returns an error code. sub GetMovieDir { my $messHash = $_[1]; my $authheader = $_[2]; my $server = $_[3]; my $port = $_[4]; my $uri = "/modules/admin/server/qtssSvrPreferences/movie_folder"; my $param = "/server/qtssSvrPreferences/movie_folder"; my $dirname = ""; my $status = EchoData($dirname, $messHash, $authheader, $server, $port, $uri, $param); if ($status eq "401") { $dirname = "Authorization_Failure"; } elsif ($dirname eq "") { if ($^O =~/[Dd]arwin/) { $dirname = "/Library/QuickTimeStreaming/Movies"; } elsif ($^O eq "MSWin32") { $dirname = "c:\\Program Files\\Darwin Streaming Server\\Movies"; } else { $dirname = "/usr/local/movies/"; } } $_[0] = $dirname; return $status; } # MakeArray(text, name, [size]) # Parses the scalar text for the container name and # returns an array of all the values. If size is given # it looks for size number of elements else it finds all sub MakeArray { my $text = $_[0]; my $name = $_[1]; my $size = 0; my $count = 0; if($_[3]) { $size = $_[3]; } my @lines = split /\r|\n/, $text; my $line; my @arr; $#arr = $size - 1; # pre-grow the array if we know its size while(@lines) { $line = shift @lines; # if($line =~ m/^Container=\"(.*)$name\"(\s*)$/) { if($line =~ m/^Container=\"(.*)\"$/) { while(1) { $line = shift @lines; if($line =~ m/^$count=\"(.*)\"(\s*)$/) { $arr[$count] = $1; $count++; if(($size != 0) && ($size == $count)) { last; } } else { last; } } last; } elsif($line =~ m/^(.*?)=\"(.*?)\"/) { $arr[0] = $2; last; } } return \@arr; } #sub FormatArray (\@arrName, beginIndex, endIndex, prefix, suffix) # Formats the elements of the array by applying the # prefix and the suffix to each element in the array # returns the formatted text sub FormatArray { my $arRef = $_[0]; my @arr = @$arRef; my $index = $_[1]; my $endIndex = ($_[2] == -1) ? $#arr : $_[2]; my $prefix = $_[3]; my $suffix = $_[4]; local $responseText= ""; for($index; $index <= $endIndex; $index++) { $responseText .= $prefix.$arr[$index].$suffix; } return scalar $responseText; } # sub HasValue (\@arrOfHash, value, ["num" | alpha"]) # Returns 1 if the array contains the value, 0 otherwise. sub HasValue { my $arRef = $_[0]; my @arr = @$arRef; my $value = $_[1]; my $type = $_[2]; if($type eq "num") { for($i = 0; $i <= $#arr; $i++) { if($arr[$i] == $value) { return 1; } } } elsif($type eq "alpha") { for($i = 0; $i <= $#arr; $i++) { if($arr[$i] eq $value) { return 1; } } } return 0; } # sub SetAttribute (data, messageHash, authheader, server, port, fullpath, value, [type]) # Sends an admin protocol set command and returns the error value sub SetAttribute { # get the value $valueStr = $_[6]; # encode value as percent-escaped string $valueStr =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; my $uri = "/modules".$_[5]."?command=set+value="."\"$valueStr\""; my $code = 400; if($_[7]) { $uri .= "+type=$_[7]"; } my $data = ""; $status = GetData($data, $_[1], $_[2], $_[3], $_[4], $uri); if($status == 200) { if($data =~ m/^error:\((.*)\)/) { $code = $1; } } else { $code = $status; $_[0] = $data; } return $code; } # sub SetPassword (data, messageHash, authheader, server, port, qtssUsersFileAttr, value, qtssPasswdName, qtssAdmin) # Sends an admin protocol set command for the admin password and returns the error value sub SetPassword { my $code = 200; my $data = ""; my $password = ""; if($_[6] eq ""){ $code = 200; $_[0] = "No password given"; return; } #if($_[6] !~ /^[a-zA-Z_0-9\t\r\n\f]+$/) #{ # # the password contains other than alphanumeric ascii characters # $code = 500; # $_[0] = "The password contains other than alphanumeric ascii characters."; # return $code; #} #if($_[6] =~ /\s+/) { # $password = qq("). $_[6] . qq("); #} #else { # $password = $_[6]; #} #Get the name of the default users file from QTSS # that's where the current username:password record is my $uri = "/modules/admin". $_[5]; my $status = EchoData($data, $_[1], $_[2], $_[3], $_[4], $uri, $_[5]); if ($status != 200) { $code = $status; $_[0] = $data; } else { if ($^O eq "MSWin32") { # for windows, we need to use double quotes around the args and not single quotes $programArgs = "\"$_[7]\" -f \"$data\" -p \"$_[6]\" \"$_[8]\""; } else { # for macosx and other unixes, we need to use single quotes around the args $programArgs = "\"$_[7]\" -f \"$data\" -p \'$_[6]\' \'$_[8]\'"; } if($^O ne "MSWin32") { if(system($programArgs) == 0) { $code = 200; } else { $code = 500; $_[0] = "Error running password application."; return $code; } $_[0] = ""; } else { $progName = qq($_[7]); eval "require Win32::Process"; if(!$@) { Win32::Process::Create( $processObj, $progName, $programArgs, 1, DETACHED_PROCESS, ".") || return $code; $processObj->SetPriorityClass(NORMAL_PRIORITY_CLASS); $processObj->Wait(0); sleep(2); $_[0] = "Password Set"; $code = 200; } } } return $code; } # Runs qtpasswd to delete the username record from the users file # DeleteUsername( outputresultstring, messagesHash, authHeader, QTSSIP, QTSSport, UsersFileAttribute, QTPasswdpath, oldUsername) sub DeleteUsername { my $code = 200; my $data = ""; my $password = ""; if($_[7] eq ""){ $code = 200; $_[0] = "No username given"; return; } #Get the name of the default users file from QTSS # that's where the current username:password record is my $uri = "/modules/admin". $_[5]; my $status = EchoData($data, $_[1], $_[2], $_[3], $_[4], $uri, $_[5]); if ($status != 200) { $code = $status; $_[0] = $data; } else { # commandWithArgs is used on macosx and other unixes # so enclose args in single quotes my $commandWithArgs = "\"$_[6]\" -f \"$data\" -F -d \'$_[7]\'"; # args is used on windows # so enclose args in double quotes my $args = "-f \"$data\" -F -d \"$_[7]\""; if($^O ne "MSWin32") { if(system($commandWithArgs) == 0) { $code = 200; } else { $code = 500; $_[0] = "Error running password application."; return $code; } $_[0] = ""; } else { &playlistlib::LaunchWin32Process($_[6], "\"$_[6]\"", $args, 1); sleep(2); $_[0] = "Username deleted"; $code = 200; } } return $code; } # sub AddValueToAttribute (data, messageHash, authheader, server, port, fullpath, value) sub AddValueToAttribute { my $uri = "/modules".$_[5]."?command=add+value="."\"$_[6]\""; my $code = 0; my $data = ""; $status = GetData($data, $_[1], $_[2], $_[3], $_[4], $uri); if($status == 200) { if($data =~ m/^error:\((.*?)\)$/) { $code = $1; } } else { $code = $status; $_[0] = $data; } return $code; } # sub DeleteValueFromAttribute (data, messageHash, authheader, server, port, fullpath, value) sub DeleteValueFromAttribute { my $server = $_[3]; my $port = $_[4]; my $fullpath = $_[5]; my $value = $_[6]; my $code = 0; my $data = ""; my $status = GetData($data, $_[1], $_[2], $server, $port, "/modules".$fullpath."/*"); if($status != 200) { $code = $status; $_[0] = $data; return $code; } my $arRef = MakeArray($data, $fullpath."/"); my @arr = @$arRef; my $index = -1; for($i = 0; $i <= $#arr; $i++) { if($arr[$i] eq $value) { $index = $i; last; } } if($index != -1) { my $uri = "/modules".$fullpath."/$index"."?command=del"; $data = ""; $status = GetData($data, $_[1], $_[2], $server, $port, $uri); if($status == 200) { if($data =~ m/^error:\((.*?)\)$/) { $code = $1; } } else { $code = $status; $_[0] = $data; } } return $code; } # sub ParseFile (data, authheader, server, port, filename, [func], [param], [value]....) # Parses the file for all the server side includes and processes them # returns the processed file data in a scalar # The multiple sets of arguments func, param, and value are for taking # some input in the cgi for some server side includes # return values: 200 - parsing okay and qtss returned values # data returned is the output # 401 - parsing okay but qtss returned authorization failed # data returned is the auth challenge http headers # 500 - qtss is not responding # data - must be empty sub ParseFile { my $authheader = $_[1]; my $server = $_[2]; my $port = $_[3]; my $filename = $_[4]; my %funcparam; my $fkey; my $fvalue; for($i = 5; $i <= $#_; $i = $i + 3) { $fkey = $_[$i] . ":" . $_[$i+1]; $fvalue = $_[$i+2]; $funcparam{$fkey} = $fvalue; } my $messHash = GetMessageHash(); my %messages = %$messHash; local (*TEMPFILE, $_); # Open the file if(!open(TEMPFILE, $filename)) { $_[0] = "$messages{'FileOpenError'} $filename: $!\n"; return; } # Read the entire file into a buffer and close file handle read(TEMPFILE, $_, -s $filename); close(TEMPFILE); my %varHash = (); my $data = ""; my $status; # Look for <%% Func param%%> tags while(/^(.*?)<%%(.*?)%%>(.*)$/s) { $_[0] .= $1; $_ = $3; $tag = $2; if($tag =~ m/^ECHODATA\s+(.*)/s) { @params = split /\s+/, $1; $uri = "/modules/admin".$params[0]; $data = ""; $status = EchoData($data, $messHash, $authheader, $server, $port, $uri, $params[0]); if($status == 401) { $_[0] = $data; return $status; } elsif($status == 500) { $data = ""; } $_[0] .= $data; } elsif($tag =~ m/^GETDATA\s+(.*)/s) { #storing the retrieved text in a variable hashed to the name @params = split /\s+/, $1; $uri = "/modules/admin".$params[1]; $data = ""; $status = GetData($data, $messHash, $authheader, $server, $port, $uri); if($status == 401) { $_[0] = $data; return $status; } elsif($status == 500) { undef($data); } $varHash{$params[0]} = $data; } elsif($tag =~ m/^GETVALUE\s+(.*)/s) { #extract the value from the retreived text and store in a variable for later use @params = split /\s+/, $1; $uri = "/modules/admin".$params[1]; $data = ""; $status = EchoData($data, $messHash, $authheader, $server, $port, $uri, $params[1]); if($status == 401) { $_[0] = $data; return $status; } elsif($status == 500) { undef($data); } $varHash{$params[0]} = $data; } elsif($tag =~ m/^MAKEARRAY\s+(.*)/s) { #storing the array reference returned hashed to the name @params = split /\s+/, $1; if(defined($varHash{$params[2]})) { $arRef = MakeArray($varHash{$params[2]}, $params[1]); $varHash{$params[0]} = $arRef; } else { undef($varHash{$params[0]}); } } elsif($tag =~ m/^HASVALUE\s+(.*)/s) { #returning 1 if the value exists in the array, 0 otherwise @params = split /\s+/, $1; $params[2] = ($params[2] =~ m/^\'(.*)\'/) ? $1 : $params[2]; if(defined($varHash{$params[1]})) { $found = HasValue($varHash{$params[1]}, $params[2], $params[3]); $varHash{$params[0]} = $found; } else { undef($varHash{$params[0]}); } } elsif($tag =~ m/^IFVALUEEQUALS\s+(.*)/s) { #returning 1 if the value exists in the array, 0 otherwise @params = split /\s+/, $1; $params[2] = ($params[2] =~ m/^\'(.*)\'/) ? $1 : $params[2]; if(!defined($varHash{$params[1]})) { undef($found); } elsif($varHash{$params[1]} eq $params[2]) { $found = 1; } else { $found = 0; } $varHash{$params[0]} = $found; } elsif($tag =~ m/^CONVERTTOLOCALTIME\s+(\S+)/) { my $timeval = $varHash{$1}; if(!defined($timeval)) { $_[0] .= ""; } else { my @tm = localtime($timeval/1000); my $lang = $ENV{"LANGUAGE"}; if($lang eq "de") { $_[0] .= sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d", $messages{$weekdayStr[$tm[6]]}, $tm[3], $messages{$monthStr[$tm[4]]}, $tm[5]+1900, $tm[2], $tm[1], $tm[0]; } elsif($lang eq "ja") { $_[0] .= sprintf "%d %s %d %s, %2.2d:%2.2d:%2.2d", $tm[5]+1900, $messages{$monthStr[$tm[4]]}, $tm[3], $messages{$weekdayStr[$tm[6]]}, $tm[2], $tm[1], $tm[0]; } elsif($lang eq "fr") { $_[0] .= sprintf "%s %d %s %d %2.2d:%2.2d:%2.2d", $messages{$weekdayStr[$tm[6]]}, $tm[3], $messages{$monthStr[$tm[4]]}, $tm[5]+1900, $tm[2], $tm[1], $tm[0]; } else { $_[0] .= sprintf "%s, %d. %s %d %2.2d:%2.2d:%2.2d", $messages{$weekdayStr[$tm[6]]}, $tm[3], $messages{$monthStr[$tm[4]]}, $tm[5]+1900, $tm[2], $tm[1], $tm[0]; } } } elsif($tag =~ m/^ACTIONONDATA\s+(\S+)\s+(\S+)\s+(\S+)\s+\'(.*?)\'(\s*)/s) { $refKey = $1; if(defined($varHash{$2}) && defined($varHash{$3})) { $varHash{$refKey} = eval($varHash{$2} . $4 . $varHash{$3}); } else { undef($varHash{$refKey}); } } elsif($tag =~ m/^FORMATFLOAT\s+(\S+)/s) { if(defined($varHash{$1})) { $_[0] .= sprintf "%3.2f", $varHash{$1}; } else { $_[0] .= ""; } } elsif($tag =~ m/^CONVERTMSECTIMETOSTR\s+(\S+)/) { if(defined($varHash{$1})) { my $timeStr = ConvertTimeToStr($varHash{$1}, $messHash); $_[0] .= $timeStr; } else { $_[0] .= ""; } } elsif($tag =~ m/^MODIFYDATA\s+(\S+?)\s+\'(.*?)\'\s+\'(.*?)\'/s) { $value = $varHash{$1}; $condition = $2; $action = $3; if(defined($value)) { $newVal = ModifyData($value, $condition, $action); $_[0] .= $newVal; } else { $_[0] .= ""; } } elsif($tag =~ m/^PRINTFILE\s+(\S+?)\s+(\S+)/s) { if(!defined($varHash{$1}) || !defined($varHash{$2})) { $_[0] .= ""; } else { $_[0] .= GetFile($varHash{$1}, $varHash{$2}, $messHash); } } elsif($tag =~ m/^PRINTHTMLFORMATFILE\s+(\S+?)\s+(\S+)/s) { if(!defined($varHash{$1}) || !defined($varHash{$2})) { $_[0] .= ""; } else { $_[0] .= GetFormattedFile($varHash{$1}, $varHash{$2}, $messHash); } } elsif($tag =~ m/PROCESSFILE\s+(\S+?)\s+(\S+?)\s+(\S+?)\s+(\S+)/s) { my $ref = $1; if(defined($varHash{$2}) && defined($varHash{$2})){ $varHash{$ref} = ProcessFile($varHash{$2}, $varHash{$3}, $4); } else { undef($varHash{$ref}); } } elsif($tag =~ m/^HTMLIZE\s+(\S+)/s) { $text = $varHash{$1}; if(defined($text)) { $htmlText = HtmlEscape($text); $_[0] .= $htmlText; } else { $_[0] .= ""; } } elsif($tag =~ m/^PRINTDATA\s+(\S+)\s+\'(.*?)\'\s+\'(.*?)\'/s) { if(!defined($varHash{$1})) { $_[0] .= ""; } elsif( $varHash{$1} == 1) { $_[0] .= $2; } else { $_[0] .= $3; } } elsif($tag =~ m/^CONVERTTOVERSIONSTR\s+(\S+)/s) { if(defined($varHash{$1})) { $_[0] .= ConvertToVersionString($varHash{$1}); } else { $_[0] .= ""; } } elsif($tag =~ m/^CREATESELECTFROMINPUTWITHFUNC\s+(\S+?)\s+(\S+?)\s+(.*)/s) { my $name = $1; $value = $funcparam{"CREATESELECTFROMINPUTWITHFUNC:$name"}; if(defined($value)) { my $handler = $2; my $optstr = $3; my @options = (); my $i = 0; while($optstr =~ m/\'(.*?)\'\s+(.*)/) { $options[$i] = "