#!/usr/bin/perl
# http://web.cs.dal.ca/~vlado/srcperl/htpasswd-update.pl
# Copyright 2005-12 Vlado Keselj web.cs.dal.ca/~vlado

sub help { print STDERR <<"#EOT" }
# Update htpasswd file using a plain-text db
#
# Usage: htpasswd [switches] file.db htpasswd.file
#  -h    Print help and exit.
#  -v    Print version of the program and exit.
#
# Uses: htpasswd
#
#file.db format example (other attributes are permitted):
#userid:someuserid
#name:This Field Is Not Used (can be more of them)
#password:U8S7F0
#
#comment:empty line is record separator
#userid:another
#password:ldkjf91
#EOT

use strict;
use vars qw( $VERSION );
$VERSION = sprintf "%d.%d", q$Revision: 1.3 $ =~ /(\d+)/g;

use Getopt::Std;
use vars qw($opt_v $opt_h);
getopts("hv");

if ($opt_v) { print "$VERSION\n"; exit; }
elsif ($opt_h || $#ARGV!=1) { &help(); exit; }

my $dbfile = shift;  my $passwdfile = shift;

foreach my $r (@{ &read_db("file=$dbfile") } ) {
  my $userid = $r->{userid};
  die "Userid format!?:($userid)" unless $userid =~ /^[\w-]+$/;
  my $passwd = $r->{password};
  die "password=($passwd)" unless $passwd =~ /^[.,\w]+$/;
  print "htpasswd -b $passwdfile $userid $passwd\n";
  print `htpasswd -b $passwdfile $userid $passwd`;
}

sub read_db {
  my $arg = shift;
  if ($arg =~ /^file=/) { $arg = getfile($') }
  my $db = [];
  while ($arg) {
      $arg =~ s/^\s*(#.*\s*)*//;  # allow comments betwen records
      my $record;
      if ($arg =~ /\n\n+/) { $record = "$`\n"; $arg = $'; }
      else { $record = $arg; $arg = ''; }
      my $r = {};
      while ($record) {
        while ($record =~ /^(.*)(\\\n|\n[ \t]+)(.*)/)
	{ $record = "$1 $3$'" }
        $record =~ /^([^\n:]*):(.*)\n/ or die;
        my $k = $1; my $v = $2; $record = $';
        if (exists($r->{$k})) {
          my $c = 0;
          while (exists($r->{"$k-$c"})) { ++$c }
          $k = "$k-$c";
        }
        $r->{$k} = $v;
      }
      push @{ $db }, $r;
  }
  return $db;
}

sub getfile($) {
    my $f = shift;
    local *F;
    open(F, "<$f") or die "getfile:cannot open $f:$!";
    my @r = <F>;
    close(F);
    return wantarray ? @r : join ('', @r);
}