#!/usr/bin/perl # Copyright 1999-2012. Parallels IP Holdings GmbH. All Rights Reserved. package HelpFuncs; # Port to Unix use Logging; use EncodeBase64; use Socket; sub negation{ my ($val) = @_; if ($val eq 'true') { return 'false'; } if ($val eq 'false') { return 'true'; } } sub checkValue{ my ($val, $defaultVal, $checkVal) = @_; if( defined $val ) { if ( defined $checkVal ) { return $checkVal if $val eq $checkVal; } else { return $val; } } return $defaultVal; } sub dieWithError{ my( $msg, $errCode ) = @_; $errCode = -1 if not $errCode; log_error( "The program faield with error $errCode", $msg ); my $idx = 1; my $package = 1; my $tab = ' '; my $callstack = ''; while( $package and $idx<15 ) { my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($idx); if( $package ) { $tab = $tab . ' '; $callstack .= "\n$tab Stack[$idx]. Sub:$subroutine [Package:$package][Filename:$filename]Line:$line"; } $idx = $idx + 1; } die "\nDie with error:$msg\nCall stack:\n$callstack"; } # Returns string, suitable for using in 'IN ($list)' sql clause sub getSqlList { return join(',', map {"'$_'"} sort {$a <=> $b} @_); } sub blockToNum { my ( $mask ) = @_; my $longMask = unpack( "N", pack( "C4", split( /\./, $mask ) ) ); my $block; for ( $block = 0 ; $block < 32 ; $block = $block + 1 ) { my $tmp = 2**( 32 - $block - 1 ); last if !( $longMask & $tmp ); } return $block; } # # url decode (certificates in Plesk DB encoded by the url encoding) # sub urlDecode { my $url = $_[0]; $url =~ tr/+/ /; $url =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg; return $url; } sub makeMIMEBase64 { my ($useModule); if (eval "require MIME::Base64") { $useModule = 1; } else { $useModule = 0; } my $this = { 'ENCODE' => sub { my ($text) = @_; if ($useModule) { my $encoded = MIME::Base64::encode($text); chomp $encoded; return $encoded; } else { return EncodeBase64::encode($text); } } }; return $this; } sub randomPasswd { my $len = shift; if ( $len <= 0 ) { $len = 8; } my $symbols = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'; my $seq_length = length($symbols); my $passwd = ''; for (my $i = 0; $i <= $len; ++$i) { $passwd .= substr($symbols, rand($seq_length), 1); } return $passwd; } sub getUniqueDir{ my( $path, $prefix ) = @_; my $cnt = 1; while( -e "$path/$prefix\[$cnt\]" ){ $cnt += 1; } return "$path/$prefix\[$cnt\]"; } sub deleteFolder{ my( $path ) = @_; opendir( DH, $path ); my $dir; while( ( $dir = readdir( DH ) ) ){ if( not $dir eq '.' and not $dir eq '..' ){ if( -d "$path/$dir" ) { deleteFolder( "$path/$dir" ); if( not rmdir "$path/$dir" ) { Logging::error("Cannot delete directory $path/$dir"); } } else{ unlink "$path/$dir" or Logging::error("Cannot delete file '$path/$dir'"); } } } closedir( DH ); if( not rmdir $path ) { Logging::error("Cannot delete directory $path"); } } sub make_path { my $arg = {}; if (@_ and (ref($_[-1]) =~ /HASH/) ) { $arg = pop @_; } if (exists $arg->{owner} and $arg->{owner} =~ /\D/) { my $uid = (getpwnam $arg->{owner})[2]; if (defined $uid) { $arg->{owner} = $uid; } else { Logging::error("Unable to map $arg->{owner} to a uid, ownership not changed"); delete $arg->{owner}; } } if (exists $arg->{group} and $arg->{group} =~ /\D/) { my $gid = (getgrnam $arg->{group})[2]; if (defined $gid) { $arg->{group} = $gid; } else { Logging::error("Unable to map $arg->{group} to a gid, group ownership not changed"); delete $arg->{group}; } } if (exists $arg->{owner} and not exists $arg->{group}) { $arg->{group} = -1; # chown will leave group unchanged } if (exists $arg->{group} and not exists $arg->{owner}) { $arg->{owner} = -1; # chown will leave owner unchanged } push @_, $arg; _make_path(@_); } sub _make_path { my $arg = pop @_; my @paths = @_; foreach $path (@paths) { next unless defined($path) and length($path); next if -d $path; my @dirs = split ('/', $path); pop @dirs; my $parent = join('/',@dirs); unless (-d $parent or $path eq $parent) { _make_path( $parent, $arg); } if (mkdir $path, (exists $arg->{mode})? $arg->{mode}: 0755) { if( exists $arg->{owner} and exists $arg->{group}) { if (!chown 0+$arg->{owner}, 0+$arg->{group}, $path) { Logging::error("Cannot chown on '$path' to '$arg->{owner}:$arg->{group}'"); } } if (exists $arg->{mode}) { if (!chmod $arg->{mode}, $path) { Logging::error("Cannot chmod on '$path' to $arg->{mode}"); } } } else { Logging::error("Cannot mkdir '$path'"); } } } # ($total, $avail, $mount) = getMountSpace('path') sub getMountSpace { my $mount = shift; my $df = qx( df -P $mount) or die $!; while ( $df =~ /^(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+\%)\s+(\S+)$/gm ) { return (512*$2, 512*(0+$2-$3), 512*$6); } return; } sub epoch2CrDate { my $epoch = shift; unless ( $epoch ) { return '1970-01-01'; } my ($mday, $mon, $year) = (localtime($epoch)) [3 .. 5]; return sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday); } sub getTime { my ($sec, $minute, $hour, $day, $month, $year) = localtime(time); $year+=1900; $sec = "0".$sec if length($sec) < 2; $minute = "0".$minute if length($minute) < 2; $hour = "0".$hour if length($hour) < 2; $day = "0".$day if length($day) < 2; $month++; $month = "0".$month if length($month) < 2; return "$year.$month.$day $hour:$minute:$sec"; } sub getRelativePath { my ($subpath, $path) = @_; if ( !$subpath || !$path) { return; } $subpath =~ /^($path)\/*(.*)/; if ( defined $2 ) { return $2; } return; } my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 _ /); sub mktemp { my $path = shift; $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge; return $path; } my $lastId = 0; sub generateProcessId { return $$ . "-" . $lastId++; } # Returns the elements that present in first array, but not in the second. # Arrays must be sorted. # Linear complexity. sub arrayDifference { my ( $a1, $a2 ) = @_; my @ret; my $i1 = 0; my $i2 = 0; while ( $i1 < scalar(@$a1) && $i2 < scalar(@$a2) ) { if ( $a1->[$i1] eq $a2->[$i2] ) { $i1++; $i2++; next; } if ( $a1->[$i1] lt $a2->[$i2] ) { push @ret, $a1->[$i1]; $i1++; next; } if ( $a1->[$i1] gt $a2->[$i2] ) { $i2++; next; } } while ( $i1 < scalar(@$a1) ) { push @ret, $a1->[$i1]; $i1++; } return @ret; } # Returns the elements that present in both arrays # Arrays must be storted # Linear complexity sub arrayIntersection { my ( $a1, $a2 ) = @_; my @ret; my $i1 = 0; my $i2 = 0; while ( $i1 < scalar(@$a1) && $i2 < scalar(@$a2) ) { if ( $a1->[$i1] eq $a2->[$i2] ) { push @ret, $a1->[$i1]; $i1++; $i2++; next; } if ( $a1->[$i1] lt $a2->[$i2] ) { $i1++; next; } if ( $a1->[$i1] gt $a2->[$i2] ) { $i2++; next; } } return @ret; } sub inArray { my ($items, $value) = @_; return 0 unless ref($items) =~ /ARRAY/; foreach my $item(@{$items}) { return 1 if $item eq $value; } return 0; } sub processArray (&@) { my $code = shift; my $result; if( @_ ) { foreach my $value ( @_ ) { $result = $code->($result, $value); } } return $result; } sub min2 { $_[0] <= $_[1] ? $_[0] : $_[1]; } sub max2 { $_[0] <= $_[1] ? $_[1] : $_[0]; } sub getArraySpecialValue { my $code = shift; return processArray {(defined $_[0])? ( (defined $_[1])? $code->($_[0], $_[1]) : $_[0] ) : $_[1]} grep{ defined } @_; } sub Min { return getArraySpecialValue(\&min2,@_); } sub Max { return getArraySpecialValue(\&max2,@_); } sub hash2XmlNode { my $hashPtr = shift; my $doNotEscape = shift; return unless ( ref($hashPtr) =~ /HASH/ ); my %hash = %{$hashPtr}; my $name = $hash{'_name'}; return unless defined $name; my $xmlNode = XmlNode->new( $name ); if ( defined ( $hash{'_value'} ) and ( $hash{'_value'} ne '' ) ) { if ($doNotEscape) { $xmlNode->setTextAsIs( $hash{'_value'} ); } else { $xmlNode->setText( $hash{'_value'} ); } } if ( defined ( $hash{'_attrs'} ) and ( ref ( $hash{'_attrs'} ) =~ /HASH/ ) ) { my %attrs = %{$hash{'_attrs'}}; foreach my $attrName ( keys %attrs ) { $xmlNode->setAttribute( $attrName, $attrs{$attrName}, undef, $doNotEscape ) if defined $attrs{$attrName}; } } if ( defined ( $hash{'_children'} ) and ( ref ( $hash{'_children'} ) =~ /ARRAY/ ) ) { my @children = @{$hash{'_children'}}; foreach my $child ( @children ) { next unless ( ref( $child ) =~ /HASH/ ); my $childXmlNode = hash2XmlNode($child, $doNotEscape); $xmlNode->addChild($childXmlNode) if defined $childXmlNode; } } return $xmlNode; } sub convertPathToUnixFormat{ my ( $path ) = @_; if (defined $path) { $path =~ s/\\/\//g; $path =~ s/\/{2,}/\//g; } return $path; } sub convertToTrueFalseString { my ($str) = @_; return ($str && ($str eq '1' || $str eq 'true')) ? 'true' : 'false'; } my %ipCache; # Local IP addresses list my %hostCache; # host -> IP address sub isRemoteHost { my ($host) = @_; return 0 if ($host eq 'localhost' || $host eq '127.0.0.1'); if (!exists $hostCache{$host}) { $hostCache{$host} = inet_ntoa(scalar(gethostbyname($host)) || scalar(gethostbyname('localhost'))); } if (!%ipCache) { my @ips = (`ifconfig -a` =~ /inet addr:(\S+)/g); @ipCache{@ips} = (); } return (!exists $ipCache{$hostCache{$host}}) ? 1 : 0; } sub _isPseudoFs { my ($type) = @_; my %pseudofs = ( 'autofs' => 1, 'binfmt_misc' => 1, 'cd9660' => 1, 'devfs' => 1, 'devpts' => 1, 'fdescfs' => 1, 'iso9660' => 1, 'linprocfs' => 1, 'proc' => 1, 'procfs' => 1, 'romfs' => 1, 'sysfs' => 1, 'tmpfs' => 1, 'usbdevfs' => 1, 'usbfs' => 1, 'rpc_pipefs' => 1, 'fdesc' => 1, 'none' => 1 ); return 1 if defined($pseudofs{$type}); # MacOS pseudofs, such as return 1 if $type =~ /^<.*>$/; } sub calculateFreeSpace { my ($path) = @_; my %mounts; my $osname = `uname -s`; chomp $osname; if ($osname eq 'FreeBSD') { foreach my $mountinfo (`mount -p`) { chomp $mountinfo; my ($device, $mountpoint, $type, $options) = split /\s+/, $mountinfo; my $mode = 'rw'; $mode = 'ro' if ($options =~ /(^|,)ro(,|$)/); unless (_isPseudoFs($type)) { $mounts{$mountpoint} = (); $mounts{$mountpoint}->{'device'} = $device; $mounts{$mountpoint}->{'mode'} = $mode; $mounts{$mountpoint}->{'type'} = $type; } } } elsif ($osname eq 'Linux') { foreach my $mountinfo (`mount`) { chomp $mountinfo; #unable to use 'undef' here - perl 5.004 compatibility my ($device, $undef, $mountpoint, $undef, $type, $options) = split /\s+/, $mountinfo; my $mode = 'rw'; $mode = 'ro' if ($options =~ /[(,]ro[,)]/); my ($fs, $opts) = split /,/, $type, 2; unless (_isPseudoFs($fs)) { $mounts{$mountpoint} = (); $mounts{$mountpoint}->{'device'} = $device; $mounts{$mountpoint}->{'mode'} = $mode; $mounts{$mountpoint}->{'type'} = $fs; } } } elsif ($osname eq 'Darwin') { foreach my $mountinfo (`mount`) { chomp $mountinfo; my ($device, $mountpoint, $options) = ($mountinfo =~ /^(.*)\son\s(.*?)(?:\s(\(.*\)))?$/); my $mode = 'rw'; $mode = 'ro' if ($options =~ /[( ]read-only[,)]/); unless(_isPseudoFs($device)) { $mounts{$mountpoint} = (); $mounts{$mountpoint}->{'device'} = $device; $mounts{$mountpoint}->{'mode'} = $mode; $mounts{$mountpoint}->{'type'} = 'unknown'; } } } else { Logging::debug("Unknown OS type"); return undef; } my %partitions; my $header = `LANG=C POSIXLY_CORRECT= df -Pl $path | head -n 1`; unless ($header =~ /\s(\d+)-/) { Logging::debug("Unable to determine block size in df output. First line looks like '$header'"); return undef; } my $blocksize = $1; foreach my $dfinfo (`LANG=C POSIXLY_CORRECT= df -Pl $path | tail -n +2`) { chomp $dfinfo; my ($undef, $size, $undef, $free, $undef, $mountpoint) = ($dfinfo =~ m|^(.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+%)\s+(/.*)$|); if (exists $mounts{$mountpoint}) { # for brain-dead NFS shares: $free = $size if $free > $size; $size *= $blocksize; $free *= $blocksize; next if $free =~ /[eE]\+/ or $size =~ /[eE]\+/; $partitions{$mountpoint} = $mounts{$mountpoint}; $partitions{$mountpoint}->{'size'} = $size; $partitions{$mountpoint}->{'free'} = $free; } } my $result; foreach my $partition (keys %partitions) { $result = $partitions{$partition}->{'free'}; } return $result; } sub generateUuid { # http://www.ietf.org/rfc/rfc4122.txt my @chars = split(//, 'xxxxxxxx-xxxx-4xxx-8xxx-xxxxxxxxxxxx'); my @digs = split(//, '0123456789abcdef'); my $uuid = ''; foreach my $char (@chars) { if($char eq 'x'){ $uuid.= $digs[rand(scalar(@digs))]; } else { $uuid.= $char; } } return $uuid; } sub trim { my $string = shift; $string =~ s/^\s+//; $string =~ s/\s+$//; return $string; } 1;