vchkpw.fixcrypt

#!/usr/local/bin/perl
#
# to fix vpopmail vpasswd files when an admin compiled with MD5 support,
# when his operating system lacked MD5 support (SMACK!).
#
# will only work if vpopmail was compiled with clear text password option.
#

use strict;
my %paths;

my ($uid,$gid) = (getpwnam('vpopmail'))[2,3];

open(A, '/var/qmail/users/assign') || die "cannot open assign: $!\n";
while(){
   if(/^\+[^:]+-:([^:]+):\d+:\d+:([^:]+):/){
		if((-f "$2/vpasswd") && (! -l $2)){
			$paths{$1} = $2;
		}
   }
}
close A;
my @set = ('A'..'Z', 'a'..'z', '0'..'9', '.', '/'); # as per Tom Collins' documentation

srand(time() ^($$ + ($$ << 15)));
my @a = grep {/[a-zA-Z0-9\.\/]/} map {chr($_)} (0..256);

while(my($domain,$dir) = each %paths){
	print "working on $domain\n";
	open(V, "${dir}/vpasswd") || die "cannot open $dir/vpasswd: $!\n";
	open(N, ">${dir}/vpasswd.tmp") || die "cannot write to $dir/vpasswd.tmp: $!\n";
	my $n=0;
	while(){
		chomp(my $line = $_);
		$n++;
		if($line =~ /^([^:]+):([^:]+):(\d+):(\d+):([^:]*):([^:]+):([^:]+):(.+)$/){
			my ($user,$oldcrypt,$id,$gid,$comment,$maildir,$quota,$clear) = ($1,$2,$3,$4,$5,$6,$7,$8);
	
			my $salt = $a[ rand(@a) ] . $a[ rand(@a) ];
			my $newcrypt = crypt($clear,$salt);
			die "error while generating crypt\n" unless($newcrypt);
			# perl doesnt like s/${oldcrypt}/${newcrypt}/ if oldcrypt has a $ in it
			# and escaping is just ugly
			print N "${user}:${newcrypt}:${id}:${gid}:${comment}:${maildir}:${quota}:${clear}\n";
		}else{
			print "unknown syntax in file (line $n)\n";
			print N "${line}\n";
		}
	}
	close N;
	close V;
	if(rename("${dir}/vpasswd.tmp","${dir}/vpasswd")){
		if(chown($uid,$gid,"${dir}/vpasswd")){
			chmod(0600,"${dir}/vpasswd") || warn "could not chmod $dir/vpasswd: $!\n";
		}else{
			warn "could not chown $dir/vpasswd: $!\n";
		}
		unlink("${dir}/vpasswd.cdb") || warn "cannot delete $dir/vpasswd.cdb: $!\n";
	}else{
		warn "cannot rename $dir/vpasswd.tmp: $!\n";
	}
}