|
|
w_mem.cgi
#!/usr/bin/perl
$VERSION = '2.0';
############################################################
# Copyright (c) 2000 NETBILLING, Inc. www.netbilling.com
# All rights reserved. Use under license. Direct questions
# to support@netbilling.com
############################################################
# These coded instructions, statements and computer programs
# contain unpublished proprietary information of Netbilling,
# Inc. and are protected by Federal copyright law.
# They may not be disclosed to third parties or copied or
# duplicated in any form, in whole or in part, without the
# prior written consent of Netbilling, Inc.
############################################################
use strict;
use CGI;
use Fcntl qw(:flock);
use vars qw ($CONFIG_FILE $VERSION);
############################################################
################## Configuration section ###################
############################################################
$CONFIG_FILE = "nbmember.cfg";
#
# Put the configuration file in the same directory as this
# script. You may include comments in the file, by putting
# a ';' or '#' at the beginning of each comment line.
# Configuration file format:
#
# -----cut-----
# ; The line below contains the path to the password file.
# HTPASSWD_FILE = "/path/to/.htpasswd"
# ; Change the default keyword on line below to protect script.
# ACCESS_KEYWORD = "keyword"
# -----cut-----
#
# HTPASSWD_FILE : The full pa
th to the webserver password file.
#
# ACCESS_KEYWORD : (recomended) Used to restrict access to this
# script, so that only Netbilling's server can add or remove users
# to/from your site. To use this feature, you need to select
# a secure keyword, and enter it on the Netbilling system site
# configuration screen, as well as in the config file.
# Warning: If you don't use ACCESS_KEYWORD, anybody on the internet
# may be able to grant themselves free access to your site,
# or even remove other members!
#
############################################################
################ No changes below this line ################
############################################################
sub pwmgr ($$@);
# main
{
my @out;
my $cgi = new CGI;
my $cmd = $cgi->param('cmd');
my (@user) = $cgi->param('u');
my (@pass) = $cgi->param('p'); # UNIX crypt password (pri 1)
(@pass) = $cgi->param('w') unless @pass; # MD5 crypt Apache/Win32 (pri 2)
(@pass) = $cgi->param('m') unless @pass; # MD5 crypt password (pri 3)
(@pass) = $cgi->param('n') unless @pass; # plain text passwords
my $keyword = $cgi->param('keyword');
my $site = $cgi->param('site_tag');
my $prefix = $cgi->param('prefix')||""; # prefix used for all passwords
my ($opt,@err) = loadconfig($CONFIG_FILE);
if ($cmd eq 'test') {
# self test
@out = (1, "Control interface is live");
$opt = {} if !defined $opt;
push @out, row (' V
ersion', $VERSION),
row (' Config file', $CONFIG_FILE),
row (' Config exists', -e $CONFIG_FILE ? 'YES' : 'NO'),
row (' Config is readable', -r $CONFIG_FILE ? 'YES' : 'NO'),
row (' Config is valid', defined $opt ? 'YES' : 'NO'),
row (' Password file', $$opt{HTPASSWD_FILE}),
row (' Password file exists', -e $$opt{HTPASSWD_FILE} ? 'YES' : 'NO'),
row (' Password file is readable', -r $$opt{HTPASSWD_FILE} ? 'YES' : 'NO'),
row (' Password file is writable', -w $$opt{HTPASSWD_FILE} ? 'YES' : 'NO'),
row (' Local date and time', scalar localtime),
row (' GMT date and time', scalar gmtime),
'',
'process environment:',
'--------------------';
foreach my $k (sort keys %ENV) {
push @out, row (" $k", $ENV{$k});
}
}
elsif ($cmd && !defined $opt) {
@out = (0, @err);
}
elsif ($cmd && !exists $$opt{HTPASSWD_FILE}) {
@out = (0, "Missing password file");
}
elsif ($cmd && $$opt{ACCESS_KEYWORD} && $$opt{ACCESS_KEYWORD} ne $keyword) {
@out = (0, "Wrong keyword");
}
elsif ($cmd =~ /(append|delete)_user/i) {
my $op = uc($1);
@out = pwmgr ($op, $$opt{HTPASSWD_FILE}, $prefix, $user[0], $pass[0]);
}
elsif ($cmd =~ /list_all_users/i) {
@out = pwmgr ('LIST', $$opt{HTPASSWD_FILE});
}
elsif ($cmd =~ /update_all_users/i) {
if (@user == @pass) {
@out = pwmgr ('LOAD', $$opt{HTPASSWD_FILE}, $prefix, \@user, \@pass);
} else {
@out = (0, 'Username/password count missmatch');
}
}
else {
@out = (0, "Invalid command");
push @out, "supported cgi parameters:",
"-------------------------",
" cmd = {test",
" |append_user (post)",
" |delete_user (post)",
" |update_all_users (post)",
" |list_all_users}",
" u = <username>",
" p = <unix encrypted password>",
" w = <md5 encrypted apache/win32 password>",
" m = <md5 encrypted (unix) password>",
" n = <plain text password>",
" site_tag = <web site id>",
" keyword = <authentication token>",
" prefix = <password prefix used>";
}
my ($ok,$msg,@more) = @out;
if ($ok) {
print $cgi->header('text/plain');
print "OK: $msg\n";
} else {
print $cgi->header(-type=>'text/plain', -status=>"400 $msg");
print "ERROR: $msg\n";
}
# human readable info follows (for LIST command):
print join "\n", '', @more, '' if @more;
exit;
}
# in: {APPEND|DELETE|LIST|LOAD}, $file [, $prefix, $user, $pass]
# APPEND add/replace/update username and password pair
# DELETE remove user specified by $user.
# LIST requires no user/pass arguments.
# LOAD purge and reload all users. $user and $pass are arrayrefs.
# $file htpassword file path
# $user single username, or hashref
# $pass single password, o
r hashref
# out: {1|0}, $message, [$user,$pass,...]
sub pwmgr ($$@)
{
my ($op,$file,$prefix,$user,$pass) = @_;
my ($ok,$msg)=(0,'no operation');
my $need_update = 1;
my @list;
local (*PW);
open (PW, "+<$file") or return (0, "Failed to open $file: $!");
flock (PW, LOCK_EX) or return (0,"Failed to lock $file: $!");
my @pws = < W>;
my %pws = split /[:\n]/, join '', @pws;
map { chomp($_) } @pws;
if ($op eq 'APPEND') {
$pws{$user} = $pass;
($ok,$msg) = (1,'Updated user and password');
}
elsif ($op eq 'DELETE') {
delete $pws{$user};
($ok,$msg) = (1,'Removed user');
}
elsif ($op eq 'LIST') {
$need_update = 0;
@list = sort @pws;
($ok,$msg) = (1,'Listing all users');
}
elsif ($op eq 'LOAD') {
# remove all current passwords with the Netbilling prefix (this allows passwords
# from other sources to be left unaffected in the file.)
if (defined $user && @$user) {
map { delete $pws{$_} } grep { index($pws{$_},$prefix) == 0 } keys %pws;
for (my $i = 0; $i < @$user; ++$i) {
$pws{$$user[$i]} = $$pass[$i];
}
}
($ok,$msg) = (1,'Reloaded all users');
}
else {
return (0, "Invalid password operation: $op");
}
if ($ok && $need_update) {
# update password file
seek (PW, 0, 0); # SEEK_SET
while (my ($u,$p) = each %pws) {
print PW "$u p\n";
}
truncate (PW, tell(PW));
}
flock (PW, LOCK_UN);
close (PW);
return ($ok, $msg, @list);
}
# in: $config_file_name
#
sub loa
dconfig ($)
{
my ($file) = @_;
return (undef, "No config file specified") unless $file;
my %opt;
open (CF, "$file") || return (undef, "Faild to open $file: $!");
my $lineno;
foreach my $line (<CF>) {
++$lineno;
next if $line =~ /^\s*[;#]/; # comment
next if $line !~ /\S/; # blank line
if ($line =~ /^\s*(\w+)\s*=\s*(["'])(.*)\2\s*$/) {
$opt{$1} = $3;
} else {
return (undef, "Config file error: line $lineno", $line);
}
}
close (CF);
return (\%opt);
}
sub row ($$)
{
my $row = shift;
my $pad = 30 - length $row;
$row .= ' ' x $pad if ($pad > 0);
$row .= ': ' . shift;
return $row;
} |
|
IP卡
狗仔卡
发表于 2003-6-3 16:36:25
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
显身卡
楼主