#! /usr/bin/perl -w # Woman's Voice # users.cgi: The user account administration. # Copyright (c) 2004-2021 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # Author: imacat # First written: 2004-10-16 use 5.008; use strict; use warnings; use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5); use Selima::wov; local $SIG{"__DIE__"} = \&http_500; my $d = new Selima::Destroy; # Prototype declaration sub main(); sub check_get(); sub check_post(); sub html_page($); sub fetch_curitem(); initenv(-this_table => "users", -dbi_lock => {"users" => LOCK_EX, "usermem" => LOCK_EX, "userpref" => LOCK_EX, "groupmem" => LOCK_SH, "groups" => LOCK_SH}, -lastmod => 1, -page_param => {"keywords" => N_("users")}); main; exit 0; sub main() { local ($_, %_); my ($error, $success, $processor); # If the request is a GET query if ($ENV{"REQUEST_METHOD"} ne "POST") { $error = check_get; # If an error occurs if (defined $error) { html_page $error; # Display the page } else { html_page retrieve_status; } # If a form was POSTed from the client } else { $error = check_post; # If an error occurs if (defined $error) { # Password not saved $POST->delete("passwd", "passwd2"); error_redirect $error; # Else, save the data } else { $processor = new Selima::Processor::User($POST); $success = $processor->process; # Password not saved $POST->delete("passwd", "passwd2"); success_redirect $success; } } return; } # check_get: Check the GET arguments sub check_get() { local ($_, %_); my ($error, $FORM, $sn); # A form is requested if (is_form) { $_ = form_type; # A form to create a new item if ($_ eq "new") { # Check the privilege to manage this table unauth if !is_script_permitted; # A form to edit a current item } elsif ($_ eq "cur") { # Check the privilege to manage this table $FORM = curform; $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1; unauth unless defined get_login_sn; unauth unless is_script_permitted || $sn == get_login_sn; # Check at fetch_curitem() $error = fetch_curitem; return $error if defined $error; # A form to delete a current item } elsif ($_ eq "del") { # Check the privilege to manage this table $FORM = curform; $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1; unauth unless defined get_login_sn; unauth unless is_script_permitted; unauth if !is_su && (is_su $sn || $sn == get_login_sn); # Check at fetch_curitem() $error = fetch_curitem; return $error if defined $error; # Not a valid form } else { # Check the privilege to manage this table unauth unless is_script_permitted; return {"msg"=>N_("Incorrect form: [_1]."), "margs"=>[$_], "isform"=>0}; } # List the available items } else { # Check the privilege to manage this table unauth unless is_script_permitted; # List handler handles its own error } # OK return; } # check_post: Check the POSTed form sub check_post() { local ($_, %_); my ($checker, $error, $FORM, $sn); $_ = form_type; # A form to create a new item if ($_ eq "new") { # Check the privilege to manage this table unauth unless is_script_permitted; # Run the checker $checker = new Selima::Checker::User(curform); $error = $checker->check(qw(id passwd name supgroup)); return $error if defined $error; # A form to edit a current item } elsif ($_ eq "cur") { # Check the privilege to manage this table $FORM = curform; $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1; unauth unless defined get_login_sn; unauth unless is_script_permitted || $sn == get_login_sn; # Check at fetch_curitem() $error = fetch_curitem; return $error if defined $error; # Run the checker $checker = new Selima::Checker::User(curform); $checker->redir(qw(del)); $error = $checker->check(qw(id passwd name supgroup)); return $error if defined $error; # A form to delete a current item } elsif ($_ eq "del") { # Check the privilege to manage this table $FORM = curform; $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1; unauth unless defined get_login_sn; unauth unless is_script_permitted; unauth if !is_su && (is_su $sn || $sn == get_login_sn); # Check at fetch_curitem() $error = fetch_curitem; return $error if defined $error;; # Run the checker $checker = new Selima::Checker::User(curform); $checker->redir(qw(cancel)); # Not a valid form } else { # Check the privilege to manage this table unauth unless is_script_permitted; return {"msg"=>N_("Incorrect form: [_1]."), "margs"=>[$_], "isform"=>0}; } # OK return; } # html_page: Display the page sub html_page($) { local ($_, %_); my ($status, $LIST, $FORM); $status = $_[0]; # A form is requested if (is_form $status) { $FORM = new Selima::Form::User($status); html_header $FORM->{"title"}; html_errmsg $status; $FORM->html; html_footer; # List the available items } else { $LIST = new Selima::List::Users; html_header $LIST->{"title"}, undef, $LIST->page_param; html_errmsg $status; $LIST->html; html_footer; } return; } ################################## # Subroutines to manage the data # ################################## # fetch_curitem: Fetch the current item sub fetch_curitem() { local ($_, %_); my ($sn, $FORM, $sth, $sql, $row); # Return if fetched before return if scalar(keys %CURRENT) > 0; # Obtain the current form $FORM = curform; # No item specified return {"msg"=>N_("Please select the user."), "isform"=>0} if !defined $FORM->param("sn"); $sn = $FORM->param("sn"); # Find the record %CURRENT = fetchrec $sn, $THIS_TABLE; # If this record exist return {"msg"=>N_("This user does not exist anymore. Please select another one."), "isform"=>0} if scalar(keys %CURRENT) == 0; # Obtain the belonging groups list $sql = "SELECT groups.sn AS sn," . " groups.dsc AS title FROM usermem" . " INNER JOIN groups ON usermem.grp=groups.sn" . " WHERE usermem.member=$sn" . " AND groups.id!=" . $DBH->quote(SU_GROUP) . " AND groups.id!=" . $DBH->quote(ADMIN_GROUP) . " AND groups.id!=" . $DBH->quote(ALLUSERS_GROUP) . " ORDER BY groups.id;\n"; $sth = $DBH->prepare($sql); $sth->execute; $CURRENT{"supgroupcount"} = $sth->rows; for ($_ = 0; $_ < $CURRENT{"supgroupcount"}; $_++) { $row = $sth->fetchrow_hashref; $CURRENT{"supgroup$_"} = 1; $CURRENT{"supgroup$_" . "sn"} = $$row{"sn"}; $CURRENT{"supgroup$_" . "title"} = $$row{"title"}; } # Get the admin flag $CURRENT{"admin"} = is_admin($sn); $CURRENT{"su"} = is_su($sn); # OK return; }