ONO::Core::HostIO
package ONO::Core::HostIO;
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::Lib::Data::Crypt;
#: ONO::Core::HostIO is responsible for low level communication with the host
#: operating system.
#:
#: Note that file system I/O calls allow access to the entire host systems
#: file system (unlike ONO::IO, which only accesses the file system within
#: the document root).
#:
#: Using this module in production projects should be avoided whenever
#: possible, try to use ONO::IO or other library / toolbox features instead.
###############################################################################
# routines
###############################################################################
sub cleanpath {
#: Check and clean input path (dir and file name), remove all special
#: characters, don't allow paths starting by a dot. Add an optional ,1 to
#: make this less restrictive.
my $path = $_[1];
if ($_[2]) {
$path =~ s~[^A-Za-z0-9\/\-\_\.\ \(\)]~~gi;
} else {
$path =~ s~[^A-Za-z0-9\/\-\_\.]~~gi;
}
if ($path !~ /^\./) {
return $path;
} else {
return "ERROR - ILLEGAL PATH";
}
}
sub exec {
#: Not implemented (yet).
}
sub exists {
#: Check if dir or file exists
if (-e &cleanpath("",$_[1],$_[2])) {
return 1;
} else {
return 0;
}
}
sub usage {
#: Return dir usage in KB
my $path = &cleanpath("",$_[1]);
my $usage = `du -sk $path`;
$usage =~ s~(\ |\n|\r|\t)(.*)$~~;
return $usage;
}
sub ls {
#: List files and directories
opendir(DIR,&cleanpath("",$_[1],$_[2]));
my @objs = readdir(DIR);
closedir DIR;
return @objs;
}
sub load {
#: Load a file, return its content, removing carriage returns
#: (line feeds will be kept).
open (FILE,&cleanpath("",$_[1]));
my @data = <FILE>;
close FILE;
my $dump;
foreach my $dat (@data) {
$dat =~ s~\r~~g;
$dump .= $dat;
}
return $dump;
}
sub list {
#: List a file, return its content as an array of lines.
open (FILE,&cleanpath("",$_[1]));
my @data = <FILE>;
close FILE;
return @data;
}
sub store {
#: Store a content to a file. Be careful, existing files will be overwritten!
my $path = &cleanpath("",$_[1],$_[2]);
open (FILE,">$path");
print FILE $_[2];
close FILE;
}
sub mkdir {
#: Create a new directory.
my $path = &cleanpath("",$_[1],$_[2]);
unless (-e $path) {
`mkdir $path`;
}
}
sub mv {
#: Move a file or a directory to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`mv $path1 $path2`;
}
sub chown {
#: Change the owner of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $user = &cleanpath("",$_[2],$_[3]);
`chown $user $path`;
}
sub chgrp {
#: Change the group of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $group = &cleanpath("",$_[2],$_[3]);
`chgrp $group $path`;
}
sub chowngrpr {
#: Recursively change both the owner and the group of a directory (or a file).
my $path = &cleanpath("",$_[1],$_[4]);
my $user = &cleanpath("",$_[2],$_[4]);
my $group = &cleanpath("",$_[3],$_[4]);
if ($path =~ /[A-Za-z0-9]/ && $user =~ /[A-Za-z0-9]/ && $group =~ /[A-Za-z0-9]/) {
`chown -R $user:$group $path`;
}
}
sub chmod {
#: Change the mode (permissions, access rights) of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $mode = &cleanpath("",$_[2],$_[3]);
$mode =~ s~[^0-9]~~g;
`chmod $mode $path`;
}
sub chmodr {
#: Recursively change the mode (permissions, access rights) of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $mode = &cleanpath("",$_[2],$_[3]);
$mode =~ s~[^0-9]~~g;
if ($path =~ /[A-Za-z0-9]/) {
`chmod -R $mode $path`;
}
}
sub cp {
#: Copy a file to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`cp $path1 $path2`;
}
sub cpr {
#: Copy a directory to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`cp -r $path1 $path2`;
}
sub size {
#: Return the size of a file in bytes.
my $file = &cleanpath("",$_[1],$_[2]);
my $size = -s "$file";
return $size;
}
sub filetype {
#: Returns 'file', 'dir', 'symlink', or 'unknown'.
#: Note that 'symlink' may either link to a file or dir.
my $file = &cleanpath("",$_[1],$_[2]);
my $type = "unknown";
if (-f $file) {
$type = "file";
}
if (-d $file) {
$type = "dir";
}
if (-l $file) {
$type = "symlink";
}
return $type;
}
sub timestamp {
#: Return the modification timestamp of a file or directory
my $file = &cleanpath("",$_[1],$_[2]);
my (
$dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks
) = stat($file);
return $mtime;
}
sub symlink {
#: Create a symbolic link
my $file = &cleanpath("",$_[1],$_[3]);
my $link = &cleanpath("",$_[2],$_[3]);
`ln -s '$file' '$link'`;
}
sub unlink {
#: Remove a symbolic link
my $link = &cleanpath("",$_[1],$_[2]);
`unlink '$link'`;
}
sub rm {
#: Remove / delete a file
my $file = &cleanpath("",$_[1],$_[2]);
`rm '$file'`;
}
sub rmdir {
#: Recursively remove / delete a directory.
my $path = &cleanpath("",$_[1]);
if ($path =~ /[a-z]/ && $path =~ m~/(.*?)/(.*?)/(.*?)/~ && length $path > 24) {
#: This has not been implemented, as it is considered to be too dangerous.
}
}
sub useradd {
#: Add a UNIX user on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
my $password = &cleanpath("",$_[2]);
my $group = &cleanpath("",$_[3]);
my $home_dir = &cleanpath("",$_[4]);
my $shell = &cleanpath("",$_[5]);
if ($username =~ /^ono-/ && $password) {
my $password_hash = ONO::Lib::Data::Crypt->pwdhash($password);
my $MORE;
if ($group) {
$MORE .= " -g '$group' ";
}
if ($home_dir) {
$MORE .= " -d '$home_dir' ";
}
if ($shell) {
$MORE .= " -s '$shell' ";
}
`/usr/sbin/useradd -p '$password_hash' $MORE $username`;
}
}
sub userpwd {
#: Change a UNIX user's password on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
my $password = &cleanpath("",$_[2]);
if ($username =~ /^ono-/ && $password) {
my $password_hash = ONO::Lib::Data::Crypt->pwdhash($password);
`/usr/sbin/usermod -p '$password_hash' $username`;
}
}
sub userget {
#: Check if a UNIX user exists on the host OS, return its basic info if true.
my $user;
foreach my $line (&list("","/etc/passwd")) {
if ($line =~ /^$_[1]:/) {
$user = $line;
}
}
return $user;
}
sub userdel {
#: Remove a UNIX user on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
if ($username =~ /^ono-/) {
`/usr/sbin/userdel -f $username`;
}
}
sub groupadd {
#: Add a UNIX group on the host OS.
#: Note that this feature will need to be run as root.
my $group = &cleanpath("",$_[1]);
if ($group =~ /^ono-/) {
`/usr/sbin/groupadd $group`;
}
}
sub groupget {
#: Check if a UNIX group exists on the host OS, return its basic info if true.
my $group;
foreach my $line (&list("","/etc/group")) {
if ($line =~ /^$_[1]:/) {
$group = $line;
}
}
return $group;
}
sub mailserver_reload {
#: Reload / restart all mailserver services on the host OS.
#: Note that this feature will need to be run as root.
`/etc/init.d/sendmail restart`;
`/etc/init.d/saslauthd reload`;
`/etc/init.d/saslauthd restart`;
`/etc/init.d/spamassassin reload`;
`/etc/init.d/spamassassin restart`;
`/etc/init.d/dovecot reload`;
`/etc/init.d/dovecot restart`;
`/usr/sbin/postmap /etc/postfix/virtual`;
`/etc/init.d/postfix reload`;
`/etc/init.d/postfix restart`;
}
###############################################################################
# end of script
###############################################################################
1;
__END__
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::Lib::Data::Crypt;
#: ONO::Core::HostIO is responsible for low level communication with the host
#: operating system.
#:
#: Note that file system I/O calls allow access to the entire host systems
#: file system (unlike ONO::IO, which only accesses the file system within
#: the document root).
#:
#: Using this module in production projects should be avoided whenever
#: possible, try to use ONO::IO or other library / toolbox features instead.
###############################################################################
# routines
###############################################################################
sub cleanpath {
#: Check and clean input path (dir and file name), remove all special
#: characters, don't allow paths starting by a dot. Add an optional ,1 to
#: make this less restrictive.
my $path = $_[1];
if ($_[2]) {
$path =~ s~[^A-Za-z0-9\/\-\_\.\ \(\)]~~gi;
} else {
$path =~ s~[^A-Za-z0-9\/\-\_\.]~~gi;
}
if ($path !~ /^\./) {
return $path;
} else {
return "ERROR - ILLEGAL PATH";
}
}
sub exec {
#: Not implemented (yet).
}
sub exists {
#: Check if dir or file exists
if (-e &cleanpath("",$_[1],$_[2])) {
return 1;
} else {
return 0;
}
}
sub usage {
#: Return dir usage in KB
my $path = &cleanpath("",$_[1]);
my $usage = `du -sk $path`;
$usage =~ s~(\ |\n|\r|\t)(.*)$~~;
return $usage;
}
sub ls {
#: List files and directories
opendir(DIR,&cleanpath("",$_[1],$_[2]));
my @objs = readdir(DIR);
closedir DIR;
return @objs;
}
sub load {
#: Load a file, return its content, removing carriage returns
#: (line feeds will be kept).
open (FILE,&cleanpath("",$_[1]));
my @data = <FILE>;
close FILE;
my $dump;
foreach my $dat (@data) {
$dat =~ s~\r~~g;
$dump .= $dat;
}
return $dump;
}
sub list {
#: List a file, return its content as an array of lines.
open (FILE,&cleanpath("",$_[1]));
my @data = <FILE>;
close FILE;
return @data;
}
sub store {
#: Store a content to a file. Be careful, existing files will be overwritten!
my $path = &cleanpath("",$_[1],$_[2]);
open (FILE,">$path");
print FILE $_[2];
close FILE;
}
sub mkdir {
#: Create a new directory.
my $path = &cleanpath("",$_[1],$_[2]);
unless (-e $path) {
`mkdir $path`;
}
}
sub mv {
#: Move a file or a directory to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`mv $path1 $path2`;
}
sub chown {
#: Change the owner of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $user = &cleanpath("",$_[2],$_[3]);
`chown $user $path`;
}
sub chgrp {
#: Change the group of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $group = &cleanpath("",$_[2],$_[3]);
`chgrp $group $path`;
}
sub chowngrpr {
#: Recursively change both the owner and the group of a directory (or a file).
my $path = &cleanpath("",$_[1],$_[4]);
my $user = &cleanpath("",$_[2],$_[4]);
my $group = &cleanpath("",$_[3],$_[4]);
if ($path =~ /[A-Za-z0-9]/ && $user =~ /[A-Za-z0-9]/ && $group =~ /[A-Za-z0-9]/) {
`chown -R $user:$group $path`;
}
}
sub chmod {
#: Change the mode (permissions, access rights) of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $mode = &cleanpath("",$_[2],$_[3]);
$mode =~ s~[^0-9]~~g;
`chmod $mode $path`;
}
sub chmodr {
#: Recursively change the mode (permissions, access rights) of a file or a directory.
my $path = &cleanpath("",$_[1],$_[3]);
my $mode = &cleanpath("",$_[2],$_[3]);
$mode =~ s~[^0-9]~~g;
if ($path =~ /[A-Za-z0-9]/) {
`chmod -R $mode $path`;
}
}
sub cp {
#: Copy a file to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`cp $path1 $path2`;
}
sub cpr {
#: Copy a directory to a new location.
my $path1 = &cleanpath("",$_[1],$_[3]);
my $path2 = &cleanpath("",$_[2],$_[3]);
`cp -r $path1 $path2`;
}
sub size {
#: Return the size of a file in bytes.
my $file = &cleanpath("",$_[1],$_[2]);
my $size = -s "$file";
return $size;
}
sub filetype {
#: Returns 'file', 'dir', 'symlink', or 'unknown'.
#: Note that 'symlink' may either link to a file or dir.
my $file = &cleanpath("",$_[1],$_[2]);
my $type = "unknown";
if (-f $file) {
$type = "file";
}
if (-d $file) {
$type = "dir";
}
if (-l $file) {
$type = "symlink";
}
return $type;
}
sub timestamp {
#: Return the modification timestamp of a file or directory
my $file = &cleanpath("",$_[1],$_[2]);
my (
$dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks
) = stat($file);
return $mtime;
}
sub symlink {
#: Create a symbolic link
my $file = &cleanpath("",$_[1],$_[3]);
my $link = &cleanpath("",$_[2],$_[3]);
`ln -s '$file' '$link'`;
}
sub unlink {
#: Remove a symbolic link
my $link = &cleanpath("",$_[1],$_[2]);
`unlink '$link'`;
}
sub rm {
#: Remove / delete a file
my $file = &cleanpath("",$_[1],$_[2]);
`rm '$file'`;
}
sub rmdir {
#: Recursively remove / delete a directory.
my $path = &cleanpath("",$_[1]);
if ($path =~ /[a-z]/ && $path =~ m~/(.*?)/(.*?)/(.*?)/~ && length $path > 24) {
#: This has not been implemented, as it is considered to be too dangerous.
}
}
sub useradd {
#: Add a UNIX user on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
my $password = &cleanpath("",$_[2]);
my $group = &cleanpath("",$_[3]);
my $home_dir = &cleanpath("",$_[4]);
my $shell = &cleanpath("",$_[5]);
if ($username =~ /^ono-/ && $password) {
my $password_hash = ONO::Lib::Data::Crypt->pwdhash($password);
my $MORE;
if ($group) {
$MORE .= " -g '$group' ";
}
if ($home_dir) {
$MORE .= " -d '$home_dir' ";
}
if ($shell) {
$MORE .= " -s '$shell' ";
}
`/usr/sbin/useradd -p '$password_hash' $MORE $username`;
}
}
sub userpwd {
#: Change a UNIX user's password on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
my $password = &cleanpath("",$_[2]);
if ($username =~ /^ono-/ && $password) {
my $password_hash = ONO::Lib::Data::Crypt->pwdhash($password);
`/usr/sbin/usermod -p '$password_hash' $username`;
}
}
sub userget {
#: Check if a UNIX user exists on the host OS, return its basic info if true.
my $user;
foreach my $line (&list("","/etc/passwd")) {
if ($line =~ /^$_[1]:/) {
$user = $line;
}
}
return $user;
}
sub userdel {
#: Remove a UNIX user on the host OS.
#: Note that this feature will need to be run as root.
my $username = &cleanpath("",$_[1]);
if ($username =~ /^ono-/) {
`/usr/sbin/userdel -f $username`;
}
}
sub groupadd {
#: Add a UNIX group on the host OS.
#: Note that this feature will need to be run as root.
my $group = &cleanpath("",$_[1]);
if ($group =~ /^ono-/) {
`/usr/sbin/groupadd $group`;
}
}
sub groupget {
#: Check if a UNIX group exists on the host OS, return its basic info if true.
my $group;
foreach my $line (&list("","/etc/group")) {
if ($line =~ /^$_[1]:/) {
$group = $line;
}
}
return $group;
}
sub mailserver_reload {
#: Reload / restart all mailserver services on the host OS.
#: Note that this feature will need to be run as root.
`/etc/init.d/sendmail restart`;
`/etc/init.d/saslauthd reload`;
`/etc/init.d/saslauthd restart`;
`/etc/init.d/spamassassin reload`;
`/etc/init.d/spamassassin restart`;
`/etc/init.d/dovecot reload`;
`/etc/init.d/dovecot restart`;
`/usr/sbin/postmap /etc/postfix/virtual`;
`/etc/init.d/postfix reload`;
`/etc/init.d/postfix restart`;
}
###############################################################################
# end of script
###############################################################################
1;
__END__