#!/usr/bin/perl
$VERSION = '2.3';
############################################################
#
#                     !!! WARNING !!!
#
# TO MAINTAIN MEMBERSHIP SECURITY,
# DO NOT MODIFY THIS SCRIPT.
#
# MODIFYING THIS SCRIPT WILL DEFEAT THE MEMBERSHIP   
# SECURITY FEATURES OF THIS GATEWAY.
#
# IF YOU MODIFY THIS SCRIPT, YOU WILL GIVE ANYBODY ON THE
# INTERNET ACCESS TO YOUR WEBSERVER,   
#
############################################################
# Copyright (c) 1999-2011, Licensed for use by Netbilling Inc.
# http://www.netbilling.com. All rights reserved.  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";	# "/can/include/full/path/to/nbmember.cfg"
#
#	It's possible to put the configuration file in the same directory
#	as this script. However, MAKE SURE that your webserver is properly
#	configured so that it's not possible to download a copy of the
#	config file thru your webserver. If anybody obtains a copy of the
#	config file, they will be able to gain unauthorized access to your
#	site. We recomend storing the config file in a directory outside of
#	the webserver root directory.
#
#	You may include comments in the config file, by putting
#	a ';' or '#' at the beginning of each comment line.
#	Configuration file format:
#
#	-----sample-----
#	; 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	= "Change_This_Now!"
#	-----sample-----
#
# HTPASSWD_FILE	: The full path to the webserver password file.
#	Just as with the config file, MAKE SURE that the password file
#	cannot be downloaded thru your webserver.
#
# ACCESS_KEYWORD: Used to restrict access to this script, so that
#	only the gateway server can add or remove users to/from your site.
#	KEEP THE ACCESS KEYWORD SECRET! CHANGE IT IF NECESSARY.
#

############################################################
################ 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) {
    @out = (0, "Invalid command");
    push @out,	"supported cgi parameters:",
		"-------------------------",
		"      cmd = {test",
		"            |append_users                     (post)",
		"            |delete_users                     (post)",
		"            |check_users",
		"            |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>";
  }

  elsif (!$$opt{ACCESS_KEYWORD}) {
    @out = (0, "Missing keyword in config file");
  }

  elsif ($$opt{ACCESS_KEYWORD} ne $keyword) {
    @out = (0, "Wrong keyword");
  }

  elsif ($cmd eq 'test') {
    # self test
    @out = (1, "Control interface is live");
    $opt = {} if !defined $opt;

    push @out,	row ('  Version',			$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 (!defined $opt) {
    @out = (0, @err);
  }

  elsif (!exists $$opt{HTPASSWD_FILE}) {
    @out = (0, "Missing password file");
  }

  elsif ($cmd =~ /(append|delete|check)_user[s]?/i) {	# the ending 's' is optional. script MUST accept either.
    my $op = uc($1);
    @out = pwmgr ($op, $$opt{HTPASSWD_FILE}, $prefix, \@user, \@pass);
  }

  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");
  }


  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, or 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|LOCK_NB) or return (0,"Failed to lock $file: $!");
  my @pws = <PW>;
  my %pws = split /[:\n]/, join '', @pws;
  map { chomp($_) } @pws;

  if ($op eq 'APPEND') {
    my $i = 0;
    for ( ; $i < @$user; ++$i) {
      $pws{$$user[$i]} = $$pass[$i];
    }
    my $s = ($i == 1) ? "" : "s";
    ($ok,$msg) = (1,"Updated $i user$s and password$s");
  }

  elsif ($op eq 'DELETE') {
    my $i = 0;
    for ( ; $i < @$user; ++$i) {
      delete $pws{$$user[$i]};
    }
    my $s = ($i == 1) ? "" : "s";
    ($ok,$msg) = (1,"Removed $i user$s");
  }

  elsif ($op eq 'CHECK') {
    my $i = 0;
    for ( ; $i < @$user; ++$i) {
      if (exists $pws{$$user[$i]}) { push @list, join ":", $$user[$i], $pws{$$user[$i]}; }
    }
    my $s = ($i == 1) ? "" : "s";
    ($ok,$msg) = (1,"Checked $i user$s");
  }

  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 company 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 {
    ($ok,$msg) = (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 loadconfig ($)
{
  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;
}