#!/usr/bin/perl

use SOAP::Transport::HTTP;

SOAP::Transport::HTTP::CGI
	-> dispatch_to('/home/soap/modules') 
	-> handle;

##</code><code>##

package Hello;
use strict;

sub new 
{
	my $class = shift;
	my $self  = shift || { };
	bless $self, $class;
}

sub hello 
{ 
	my $self = shift;
	return 'Hello, World!' 
}

1;

##</code><code>##

package SOAPHello;
use strict;
use Hello;

my $hi;

sub new 
{
	my $class = shift;
	my $self  = { };
	
	$hi = Hello->new($self);

	bless $self, $class;
}

sub hello 
{
	return $hi->hello;
}

1;

##</code><code>##

package My::SOAP;
use strict;


# These subroutines define constants that can be 
# overridden in a subclass.  Most subclasses only 
# need to change ACL_GROUP().
# 
sub PASSWD_FILE  { '/home/soap/.htpasswd' }
sub ACL_FILE     { '/home/soap/.acl'      }
sub ACL_GROUP    { '' }


# Authenticate the user, checking their password and 
# if they have permission to access this.  Uses class data 
# $self->{user} and $self->{passwd} for checking.
#
# Return values:
#
# 1   Everything checks out
# 0   Password is wrong
# -1  Not allowed access
#
sub _authen 
{
	my $self = shift;

	use Apache::Htpasswd;
	my $htpasswd = Apache::Htpasswd->new({
		passwdFile => $self->PASSWD_FILE, 
		ReadOnly   => 1, 
	});
	return 0 unless $htpasswd->htCheckPassword($self->{user}, $self->{passwd});

	use Set::NestedGroups;
	open(ACL, '<', $self->ACL_FILE) 
		or die "Can't open " . $self->ACL_FILE . ": $!\n";
	my $acl = Set::NestedGroups->new(*ACL);
	close(ACL);
	return -1 unless $acl->member($self->{user}, $self->ACL_GROUP);

	return 1;
}

1;

##</code><code>##

package SOAPHello;
use strict;
use base 'My::SOAP';
use Hello;

# So we can use SOAP::Fault to generate error 
# messages for the client.
use SOAP::Lite;


# Make it so only users in the 'hello' group can access 
# this module.
# 
sub ACL_GROUP { 'hello' }

my $hi;

sub new 
{
	my $class = shift;
	my $self  = { };

	my $self->{user}    = shift || undef;
	my $self->{passwd}  = shift || undef;
	
	$hi = Hello->new($self);

	bless $self, $class;

	my $self->_authen;
	if($auth == 0) {
		die SOAP::Fault
			->faultcode('Server.BadAuthData') 
			->faultstring('The supplied username or password was incorrect');
	}
	elsif($auth <= 0) {
		die SOAP::Fault 
			->faultcode('Server.NoAccess') 
			->faultstring('You do not have access to this SOAP object');
	}

	return $self;
}

sub hello 
{
	return $hi->hello;
}

1;