Skip to content
GitLab
Commit d009b22b authored by frankiejol's avatar frankiejol
Browse files

Merge branch 'develop' into test/1490_test_limit

parents 5c298f75 25b6330c
Expand all Hide whitespace changes
Inline Side-by-side
.travis.yml
View file @ d009b22b
......@@ -10,7 +10,7 @@ before_install:
# - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers
# - source ~/travis-perl-helpers/init --auto
- sudo apt-get -qq update
- sudo apt-get -y install libmojolicious-perl libauthen-passphrase-perl libdbd-mysql-perl libdbi-perl libdbix-connector-perl libipc-run3-perl libnet-ldap-perl libproc-pid-file-perl libxml-libxml-perl libconfig-yaml-perl libmoose-perl libjson-xs-perl qemu-utils perlmagick libmoosex-types-netaddr-ip-perl libsys-statistics-linux-perl libio-interface-perl libiptables-chainmgr-perl libnet-dns-perl wget liblocale-maketext-lexicon-perl libmojolicious-plugin-i18n-perl libdbd-sqlite3-perl
- sudo apt-get -y install libmojolicious-perl libauthen-passphrase-perl libdbd-mysql-perl libdbi-perl libdbix-connector-perl libipc-run3-perl libnet-ldap-perl libproc-pid-file-perl libxml-libxml-perl libconfig-yaml-perl libmoose-perl libjson-xs-perl qemu-utils perlmagick libmoosex-types-netaddr-ip-perl libsys-statistics-linux-perl libio-interface-perl libnet-dns-perl wget liblocale-maketext-lexicon-perl libmojolicious-plugin-i18n-perl libdbd-sqlite3-perl
- git clone https://github.com/frankiejol/Test-SQL-Data.git ~/Test-SQL-Data
- cd ~/Test-SQL-Data
- perl Makefile.PL
......
CHANGELOG.md
View file @ d009b22b
......@@ -2,5 +2,9 @@
**Implemented enhancements:**
- Machine schedule reservation [\#1337]
- Manage nodes and networks settings [\#1305]
**Bugfixes**
- Machine in a node returns to KVMlocalhost when a machine option is modified [\#1440]
Makefile.PL
View file @ d009b22b
......@@ -19,7 +19,6 @@ WriteMakefile(
,'XML::LibXML'=> 0
,'YAML' => 0
,'Image::Magick' => 0
,'IO::Scalar' => 0
,'MooseX::Types::NetAddr::IP' => 0
,'IO::Interface' => 0
,'Sys::Statistics::Linux' => 0
......@@ -27,7 +26,6 @@ WriteMakefile(
,'Locale::Maketext::Lexicon' => 0
,'Mojolicious::Plugin::I18N' => 0
,'DBD::SQLite' => 0
,'IPTables::ChainMgr' => 0
,'Net::DNS' => 0
,'Net::OpenSSH' => 0
,'File::Rsync' => 0
......@@ -39,6 +37,6 @@ WriteMakefile(
},
test => {TESTS => 't/*.t t/*/*.t'},
clean => {FILES => ['t/.db', '/var/tmp/rvd_void'] }
clean => {FILES => ['t/.db', '/var/tmp/rvd_void','/var/tmp/node.lock','/var/tmp/fw.lock'] }
);
deb/debianize.pl
View file @ d009b22b
......@@ -30,7 +30,7 @@ my %DIR = (
,'etc/systemd/' => 'lib/systemd/system/'
);
for ( qw(css fallback fonts img js )) {
for ( qw(css fallback fonts img js favicon.ico )) {
$DIR{"public/$_"} = "usr/share/ravada/public";
}
......
debian/control-debian-10
View file @ d009b22b
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-18.04
View file @ d009b22b
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-19.04
View file @ d009b22b
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-20.04
View file @ d009b22b
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
dockerfy/.env
View file @ d009b22b
......@@ -4,7 +4,7 @@ TZ=Europe/Madrid
# If you change password remember update dockerfy/dockers/back/ravada.conf
MYSQL_DATABASE=ravada
MYSQL_ROOT_PASSWORD=Pword12345*
MYSQL_HOST=127.0.0.1
MYSQL_HOST=0.0.0.0
MYSQL_PORT=33306
MYSQL_USER=rvd_user
MYSQL_PASSWORD=Pword12345*
......
dockerfy/dockers/back/Dockerfile
View file @ d009b22b
......@@ -14,12 +14,13 @@ RUN apt-get update \
liblwp-useragent-determined-perl libvirt-clients supervisor net-tools openssh-client apt-utils curl libpbkdf2-tiny-perl \
libio-stringy-perl libvirt-daemon-system libvirt-clients netcat-openbsd qemu-kvm qemu-utils iproute2 wget bridge-utils firewalld dnsmasq iptables ebtables \
libnet-openssh-perl libdatetime-format-dateparse-perl file\
&& apt-get clean
RUN DEBIAN_FRONTEND=noninteractive apt-get install -y tzdata \
&& apt-get clean \
&& rm -rf /var/lib/apt/lists/*
RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone
ENV TZ=Europe/Madrid
RUN DEBIAN_FRONTEND=noninteractive apt-get install -y tzdata \
RUN echo "listen_tls = 0" >> /etc/libvirt/libvirtd.conf \
&& echo 'listen_tcp = 1' >> /etc/libvirt/libvirtd.conf \
# && mkdir -p /root/.ssh \
......@@ -40,5 +41,5 @@ COPY supervisord.conf /etc/supervisord.conf
#ADD src/ravada /ravada
COPY ravada.conf /etc/ravada.conf
WORKDIR /ravada
ENV PERL5LIB /ravada/lib
CMD ["/usr/bin/supervisord", "-c", "/etc/supervisord.conf"]
dockerfy/dockers/back/ravada.conf
View file @ d009b22b
db:
user: rvd_user
password: Pword12345*
host: ravada-mysql
\ No newline at end of file
host: ravada-mysql
ldap:
server: 10.1.36.224
admin_user:
dn: cn=Directory Manager
password: 12345678
base: 'dc=example,dc=com'
dockerfy/dockers/front/Dockerfile
View file @ d009b22b
......@@ -13,12 +13,16 @@ RUN apt-get update \
libfile-rsync-perl libdate-calc-perl libparallel-forkmanager-perl libdatetime-perl libencode-locale-perl netcat-openbsd \
libio-stringy-perl libvirt-clients liblwp-useragent-determined-perl supervisor net-tools apt-utils lsof mysql-client \
curl bash vim wget libnet-openssh-perl libdatetime-format-dateparse-perl \
&& apt-get clean
&& apt-get clean \
ENV TZ=Europe/Madrid
RUN DEBIAN_FRONTEND=noninteractive apt-get install -y tzdata \
&& apt-get clean \
&& rm -rf /var/lib/apt/lists/*
RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone
RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone
RUN mkdir -p /var/log/supervisor \
&& mkdir -p /run/sshd
......
dockerfy/dockers/front/ravada.conf
View file @ d009b22b
db:
user: rvd_user
password: Pword12345*
host: ravada-mysql
\ No newline at end of file
host: ravada-mysql
ldap:
server: 10.1.36.224
admin_user:
dn: cn=Directory Manager
password: 12345678
base: 'dc=example,dc=com'
dockerfy/dockers/front/supervisord.conf
View file @ d009b22b
......@@ -7,7 +7,7 @@ logfile_maxbytes=0
[program:rvd_front]
environment=PERL5LIB="./lib"
command=morbo ./script/rvd_front
command=morbo -v ./script/rvd_front
autostart=true
autorestart=true
startsecs=5
......
etc/fallback.conf
View file @ d009b22b
https://cdnjs.cloudflare.com/ajax/libs/morris.js/0.5.1/morris.css morris.js/
https://use.fontawesome.com/releases/v5.10.1/fontawesome-free-5.10.1-web.zip
https://cdnjs.cloudflare.com/ajax/libs/intro.js/2.7.0/introjs.css intro.js/bin/
https://code.jquery.com/jquery-3.5.0.min.js jquery/
https://code.jquery.com/jquery-3.5.1.slim.min.js jquery/
https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.3/umd/popper.min.js
https://jqueryui.com/resources/download/jquery-ui-1.11.4.zip
https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js
https://code.angularjs.org/1.7.8/angular-1.7.8.zip
https://cdnjs.cloudflare.com/ajax/libs/angular-ui-bootstrap/2.5.0/ui-bootstrap.min.js
https://cdn.jsdelivr.net/npm/ui-bootstrap4@3.0.6/dist/ui-bootstrap-tpls.js
https://cdnjs.cloudflare.com/ajax/libs/raphael/2.1.0/raphael-min.js raphael.js/
https://github.com/snapappointments/bootstrap-select/archive/v1.13.15.zip
https://cdnjs.cloudflare.com/ajax/libs/morris.js/0.5.1/morris.min.js morris.js/
https://cdnjs.cloudflare.com/ajax/libs/intro.js/2.7.0/intro.js intro.js/
https://github.com/twbs/bootstrap/releases/download/v4.3.1/bootstrap-4.3.1-dist.zip
......@@ -17,3 +17,14 @@ https://readthedocs.org/projects/ravada/badge/?version=latest ../img/latest.svg
https://img.shields.io/badge/License-AGPL%20v3-blue.svg ../img/License-AGPL%20v3-blue.svg
https://download.cksource.com/CKEditor/CKEditor/CKEditor%204.12.1/ckeditor_4.12.1_standard_easyimage.zip
https://ajax.googleapis.com/ajax/libs/angular_material/1.1.0/angular-material.min.js angular-material/
https://cdn.jsdelivr.net/npm/ui-bootstrap4@3.0.6/dist/ui-bootstrap-csp.css
# bookings
https://cdn.jsdelivr.net/npm/fullcalendar@5.1.0/main.css bookings/
https://cdn.jsdelivr.net/npm/clockpicker@0.0.7/dist/bootstrap-clockpicker.min.css bookings/
https://cdn.jsdelivr.net/npm/angularjs-toast@latest/angularjs-toast.css bookings/
https://cdn.jsdelivr.net/npm/angularjs-toast@latest/angularjs-toast.js bookings/
https://cdn.jsdelivr.net/npm/fullcalendar@5.1.0/main.min.js bookings/
https://cdn.jsdelivr.net/npm/fullcalendar-scheduler@5.1.0/locales-all.min.js bookings/
https://cdn.jsdelivr.net/npm/moment@2.27.0/min/moment-with-locales.min.js bookings/
https://cdn.jsdelivr.net/npm/angular-moment@1.3.0/angular-moment.min.js bookings/
https://cdn.jsdelivr.net/npm/clockpicker@0.0.7/dist/bootstrap-clockpicker.min.js bookings/
etc/get_fallback.pl
View file @ d009b22b
......@@ -20,7 +20,7 @@ $ua->max_redirects(4);
my $FILE_CONFIG = 'etc/fallback.conf';
my $DIR_FALLBACK = getcwd.'/public/fallback';
die "Error: missing fallback dir $DIR_FALLBACK"
mkdir $DIR_FALLBACK or die "Error: $! $DIR_FALLBACK"
if ! -e $DIR_FALLBACK;
sub download($url, $dst = $DIR_FALLBACK) {
......@@ -44,10 +44,12 @@ sub download($url, $dst = $DIR_FALLBACK) {
print "$url downloaded to $dst\n";
$res->content->asset->move_to($dst);
}
elsif ($res->is_error) { print $res->message."\n" }
elsif ($res->is_error) { print $res->message."\n"; exit }
elsif ($res->code == 301) { print $res->headers->location."\n" }
else { print "Error ".$res->code." ".$res->message
." downloading $url\n"}
." downloading $url\n";
exit;
}
return $dst;
}
......@@ -58,13 +60,28 @@ sub uncompress($file) {
sub get_version_badge {
return if $VERSION =~/alpha/;
$VERSION =~ s/-/--/;
# $VERSION =~ s/-/--/;
download("https://img.shields.io/badge/version-$VERSION-brightgreen.svg"
,"../img/version-$VERSION-brightgreen.svg");
}
sub remove_old_version_badge {
$VERSION =~ s/-/--/;
my $current = "version-$VERSION-brightgreen.svg";
opendir my $dir,"public/img" or die "$! public/img";
while (my $file = readdir $dir) {
next if $file !~ /^version-.*\.svg/;
next if $file eq $current;
$file = "public/img/$file";
unlink $file or die "$! $file";
}
closedir $dir;
}
#############################################################################
remove_old_version_badge();
get_version_badge();
open my $in,'<',$FILE_CONFIG or die "$! $FILE_CONFIG";
......
lib/Ravada.pm
View file @ d009b22b
This diff is collapsed.
lib/Ravada/Auth.pm
View file @ d009b22b
......@@ -4,6 +4,7 @@ use warnings;
use strict;
our $LDAP_OK;
our $SSO_OK;
use Ravada::Auth::SQL;
......@@ -32,6 +33,19 @@ sub init {
} else {
$LDAP_OK = 0;
}
if ($config->{sso} && (!defined $SSO_OK || $SSO_OK) ) {
eval {
$SSO_OK = 0;
require Ravada::Auth::SSO;
Ravada::Auth::SSO::init($config);
$SSO_OK = 1;
};
warn $@ if $@;
} else {
$SSO_OK = 0;
}
# Ravada::Auth::SQL::init($config, $db_con);
}
......@@ -64,6 +78,31 @@ sub login {
return $sql_login;
}
=head2 login_external
Tries login_external in all the submodules
my $ok = Ravada::Auth::login_external();
=cut
sub login_external {
my ($ticket, $cookie, $quiet) = @_;
my $login_ok;
if (!defined $SSO_OK || $SSO_OK) {
eval {
$login_ok = Ravada::Auth::SSO::login_external($ticket, $cookie);
};
warn $@ if $@ && $SSO_OK && !$quiet;
if ( $login_ok ) {
$login_ok->{'mode'} = 'external';
return $login_ok;
}
}
return undef;
}
=head2 enable_LDAP
Sets or get LDAP support.
......@@ -81,4 +120,23 @@ sub enable_LDAP {
$LDAP_OK = $value;
return $value;
}
=head2 enable_CAS
Sets or get CAS support.
Ravada::Auth::enable_CAS(0);
print "SSO is supported" if Ravada::Auth::enable_SSO();
=cut
sub enable_SSO {
my $value = shift;
return $SSO_OK if !defined $value;
$SSO_OK = $value;
return $value;
}
1;
lib/Ravada/Auth/LDAP.pm
View file @ d009b22b
......@@ -11,7 +11,7 @@ Ravada::Auth::LDAP - LDAP library for Ravada
use Authen::Passphrase;
use Authen::Passphrase::SaltedDigest;
use Carp qw(carp);
use Carp qw(carp croak);
use Data::Dumper;
use Digest::SHA qw(sha1_hex sha256_hex);
use Encode;
......@@ -42,6 +42,8 @@ our @OBJECT_CLASS = ('top'
,'inetOrgPerson'
);
our @OBJECT_CLASS_POSIX = (@OBJECT_CLASS,'posixAccount');
our $STATUS_EOF = 1;
our $STATUS_DISCONNECTED = 81;
our $STATUS_BAD_FILTER = 89;
......@@ -102,6 +104,87 @@ sub add_user($name, $password, $storage='rfc2307', $algorithm=undef ) {
}
}
=head2 add_user_posix
Adds a new user in the LDAP directory
Ravada::Auth::LDAP::add_user_posix($name, $password);
=cut
sub add_user_posix(%args) {
my $name = delete $args{name} or croak "Error: missing name";
my $password = delete $args{password} or croak "Error: missing password";
my $gid = (delete $args{gid} or _get_gid());
my $storage = ( delete $args{storage} or 'rfc2307');
my $algorithm = delete $args{algorithm};
confess "Error : unknown args ".dumper(\%args) if keys %args;
_init_ldap_admin();
$name = escape_filter_value($name);
$password = escape_filter_value($password);
confess "No dc base in config ".Dumper($$CONFIG->{ldap})
if !_dc_base();
my ($givenName, $sn) = $name =~ m{(\w+)\.(.*)};
my %entry = (
cn => $name
, uid => $name
, uidNumber => _new_uid()
, gidNumber => $gid
, objectClass => \@OBJECT_CLASS_POSIX
, givenName => ($givenName or $name)
, sn => ($sn or $name)
,homeDirectory => "/home/$name"
,userPassword => _password_store($password, $storage, $algorithm)
);
my $dn = "cn=$name,"._dc_base();
my $mesg = $LDAP_ADMIN->add($dn, attr => [%entry]);
if ($mesg->code) {
die "Error afegint $name to $dn ".$mesg->error;
}
}
sub _get_gid() {
my @group = search_group(name => "*");
my ($group_users) = grep { $_->get_value('cn') eq 'users' } @group;
$group_users = $group[0] if !$group_users;
if (!$group_users) {
add_group('users');
($group_users) = search_group(name => 'users');
confess "Error: I can create nor find LDAP group 'users'" if !$group_users;
}
return $group_users->get_value('gidNumber');
}
sub _new_uid($ldap=_init_ldap_admin(), $base=_dc_base()) {
my $id = 1000;
for (;;) {
my $mesg = $ldap->search( # Search for the user
base => $base,
scope => 'sub',
filter => "uidNumber=$id",
typesonly => 0,
attrs => ['*']
);
confess "LDAP error ".$mesg->code." ".$mesg->error if $mesg->code;
my @entries = $mesg->entries;
return $id if !scalar @entries;
$id++;
$id+= int(rand(10))+1;
}
}
sub default_object_class() {
return @OBJECT_CLASS;
}
sub _password_store($password, $storage, $algorithm) {
return _password_rfc2307($password, $algorithm) if lc($storage) eq 'rfc2307';
return _password_pbkdf2($password, $algorithm) if lc($storage) eq 'pbkdf2';
......@@ -193,18 +276,24 @@ sub search_user {
my $ldap = (delete $args{ldap} or _init_ldap_admin());
my $base = (delete $args{base} or _dc_base());
my $typesonly= (delete $args{typesonly} or 0);
my $escape_username = 1;
$escape_username = delete $args{escape_username} if exists $args{escape_username};
my $filter_orig = delete $args{filter};
my $sizelimit = (delete $args{sizelimit} or 100);
my $timelimit = (delete $args{timelimit} or 60);
confess "ERROR: Unknown fields ".Dumper(\%args) if keys %args;
confess "ERROR: I can't connect to LDAP " if!$ldap;
$username = escape_filter_value($username);
$username = escape_filter_value($username) if $escape_username;
$username =~ s/ /\\ /g;
my $filter = "($field=$username)";
if ( exists $$CONFIG->{ldap}->{filter} ) {
if (!defined $filter_orig && exists $$CONFIG->{ldap}->{filter} ) {
my $filter_config = $$CONFIG->{ldap}->{filter};
$filter_config = escape_filter_value($filter_config);
$filter = "(&($field=$username) ($filter_config))";
} else {
$filter = "(&($field=$username) ($filter_orig))" if $filter_orig;
}
my $mesg = $ldap->search( # Search for the user
......@@ -212,10 +301,11 @@ sub search_user {
scope => 'sub',
filter => $filter,
typesonly => $typesonly,
attrs => ['*']
attrs => ['*'],
sizelimit => $sizelimit,
timelimit => $timelimit
);
warn "LDAP retry ".$mesg->code." ".$mesg->error if $retry > 1;
if ( $retry <= 3 && $mesg->code && $mesg->code != 4 ) {
......@@ -230,6 +320,8 @@ sub search_user {
,field => $field
,retry => ++$retry
,typesonly => $typesonly
,filter => $filter_orig
,sizelimit => $sizelimit
);
}
......@@ -238,7 +330,9 @@ sub search_user {
return if !$mesg->count();
return $mesg->entries;
my @entries = $mesg->entries;
return $entries[0] if !wantarray;
return @entries;
}
=head2 add_group
......@@ -247,27 +341,45 @@ Add a group to the LDAP
=cut
sub add_group {
my $name = shift;
my $base = (shift or _dc_base());
sub add_group($name, $base=_dc_base(), $class=['groupOfUniqueNames','nsMemberOf','posixGroup','top' ]) {
$base = _dc_base() if !defined $base;
$name = escape_filter_value($name);
my $oc_posix_group;
$oc_posix_group = grep { /^posixGroup$/ } @$class;
my $mesg = $LDAP_ADMIN->add(
cn => $name
,dn => "cn=$name,ou=groups,$base"
, attrs => [ cn=>$name
,objectClass => ['groupOfUniqueNames','top']
my @attrs =( cn=>$name
,objectClass => $class
,ou => 'Groups'
,description => "Group for $name"
]
);
push @attrs, (gidNumber => _search_new_gid()) if $oc_posix_group;
my @data = (
dn => "cn=$name,ou=groups,$base"
, cn => $name
, attrs => \@attrs
);
my $mesg = $LDAP_ADMIN->add(@data);
if ($mesg->code) {
die "Error afegint $name ".$mesg->error;
die "Error creating group $name : ".$mesg->error."\n".Dumper(\@data);
}
}
sub _search_new_gid() {
my %gid;
for my $group ( search_group( name => '*' ) ) {
my $gid_number = $group->get_value('gidNumber');
next if !$gid_number;
$gid{$gid_number}++;
}
my $new_gid = 100;
for (;;) {
return $new_gid if !$gid{$new_gid};
$new_gid++;
}
}
=head2 remove_group
Removes the group from the LDAP directory. Use with caution
......@@ -301,25 +413,38 @@ sub remove_group {
sub search_group {
my %args = @_;
my $name = delete $args{name} or confess "Missing group name";
my $name = delete $args{name} or confess "Error: missing name";
my $base = ( delete $args{base} or "ou=groups,"._dc_base() );
my $ldap = ( delete $args{ldap} or _init_ldap_admin());
my $retry =( delete $args{retry} or 0);
confess "ERROR: Unknown fields ".Dumper(\%args) if keys %args;
confess "ERROR: I can't connect to LDAP " if!$ldap;
$name = escape_filter_value($name);
my $filter = "cn=$name";
my $mesg = $ldap ->search (
filter => "cn=$name"
filter => $filter
,base => $base
,sizelimit => 100
);
warn "LDAP retry ".$mesg->code." ".$mesg->error if $retry > 1;
warn "LDAP retry ".$mesg->code." ".$mesg->error." [filter: $filter , base: $base]" if $retry > 1;
if ($mesg->code == 4 ) {
if ( $name eq '*' ) {
$name = 'a*';
} elsif ($name eq 'a*' ) {
$name = 'a*a*';
} else {
die "LDAP error: ".$mesg->code." ".$mesg->error;
}
return search_group(
name => $name
,base => $base