#pragma module  PMAS_RADIUS  "PMAS_RADIUS-1-B"

/*
**++
**  FACILITY:	PMAS & RADIUS-VMS
**
**  MODULE DESCRIPTION:
**
**	 This module is a loadable image to performs a SITE specific authentication
**	procedure, in particalary: authentication of user against RADIUS-VMS server/DB.
**	This module was written by using Hunter Goatley story and help. :-)
**
**  AUTHOR:	Ruslan R. Laishev
**		Copyright 2006-2011, Ruslan R. Laishev
**
**	This  program  can  be  built by the following  procedure:
**
**	$ CC/NOWARN/NODEBUG	PMAS_RADIUS.C,MD5.C
**
**	Alpha/IA64:
**	$ LINK/SHARE/NODEBUG/NOTRACE PMAS_RADIUS.OBJ,MD5.OBJ,SYS$INPUT/OPT
**		SYMBOL_VECTOR=(PMAS_USER_AUTHENTICATE=PROCEDURE)
**	
**	VAX:
**	$ LINK/SHARE/NODEBUG/NOTRACE PMAS_RADIUS.OBJ,MD5.OBJ,SYS$INPUT/OPT
**		UNIVERSAL=PMAS_USER_AUTHENTICATE
**
**	Startup:
**	@PMAS_RADIUS_STARTUP.COM
**	
**	PMAS_CONFIG.DAT:
**	auth_methods	PMAS,SYSTEM, SITE
**
**	where keyword "SITE" is controlling a calling of external authentication module.
**
**	Quick check:
**	$ mcr pmas_exe:authdebug.exe laishev <right_password_here>
**	28-AUG-2006 13:00:16.13: Opening configuration file PMAS_ROOT:[DATA]PMAS_CONFIG.DAT;....
**	28-AUG-2006 13:00:16.17: Looking up authorization alias for address <laishev>
**	28-AUG-2006 13:00:16.17: No authorization alias found
**	28-AUG-2006 13:00:16.17: authdebug: No alias found, using 'laishev' to authenticate
**	28-AUG-2006 13:00:16.17: authenticate: Authenticating user laishev
**	28-AUG-2006 13:00:16.17: authenticate: auth_methods: SITE
**	28-AUG-2006 13:00:16.21: Status from authenticate: 1
**	$
**
**	$ mcr pmas_exe:authdebug.exe laishev <wrong_password_here>
**	28-AUG-2006 13:01:36.92: Opening configuration file PMAS_ROOT:[DATA]PMAS_CONFIG.DAT;....
**	28-AUG-2006 13:01:36.96: Looking up authorization alias for address <laishev>
**	28-AUG-2006 13:01:36.96: No authorization alias found
**	28-AUG-2006 13:01:36.96: authdebug: No alias found, using 'laishev' to authenticate
**	28-AUG-2006 13:01:36.96: authenticate: Authenticating user laishev
**	28-AUG-2006 13:01:36.96: authenticate: auth_methods: SITE
**	28-AUG-2006 13:01:37.01: authenticate: Unable to auth user, bad credentials
**	28-AUG-2006 13:01:37.01: Status from authenticate: 0
**	$
**
**	RADIUS_USERS:
**
**	DEFAULT_PMAS	Auth-Type = System, NAS-Identifier = "PMAS", Right-Id="MX_MAIL_ACCESS"
**
**	DEFAULT_PMAS	Auth-Type = Reject, NAS-Identifier = "PMAS"
**	
**
**  MODIFICATION HISTORY:
**
**	25-AUG-2006	RRL	Initial coding by using LGI$CALLOUT_RADIUS.C as template.
**	 7-APR-2011	RRL	Generating random part of the header 'auth_req->radpkt$b_vector'
**				with the sys$create_uid().
**--
*/

#include	<starlet.h>
#include	<descrip.h>
#include	<stsdef.h>
#include	<ssdef.h>
#include	<string.h>
#include	<inet.h>
#include	<iodef.h>
#include	<libdtdef.h>
#include	<in.h>
#include	<netdb.h>
#include	<ucx$inetdef.h>
#include	<time.h>
#include	<lnmdef.h>
#include	<stdlib.h>
#include	<iosbdef.h>
#include	<lgidef.h>
#include	<lib$routines.h>
#include	<efndef.h>


#define	__NEW_STARLET	1
#include	"raddef.h"
#include	<iledef.h>

$DESCRIPTOR(dsc_ucxdev,		"UCX$DEVICE");
$DESCRIPTOR(dsc_tcpipdev,	"TCPIP$DEVICE");

$DESCRIPTOR(dsc_radauth_addr,	"RADIUS$AUTH_SERVER");
$DESCRIPTOR(dsc_radauth_port,	"RADIUS$AUTH_PORT");
$DESCRIPTOR(dsc_secret,		"RADIUS$SECRET");
$DESCRIPTOR(dsc_radtmo,		"RADIUS$TIMEOUT");
$DESCRIPTOR(dsc_radretry,	"RADIUS$RETRY");
$DESCRIPTOR(dsc_table,		"RADIUS$LNM_TABLE");


/*
**
**  MACRO DEFINITIONS
**
*/

#define min(x,y)        ((x > y)?y:x)
#define max(x,y)        ((x < y)?y:x)

void    md5_calc1       (unsigned char *,unsigned char *,unsigned short,unsigned char *,unsigned short);

/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      Canceling all queued and processed request due of expiration timer.
**
**  FORMAL PARAMETERS:
**
**      reqidt:	pointer to a network channel
**
**  RETURN VALUE:
**
**      None
**
**  SIDE EFFECTS:
**
**      Cancel _all_ request for the given I/O channel.
**--
*/
void	timer_ast	(
			int	*reqidt
			)
{
	sys$cantim(reqidt,0);
	sys$cancel(*reqidt);
}


/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      Performs an authentication and authorization of the PMAS user against
**	remote RADIUS server/database.
**
**  FORMAL PARAMETERS:
**
**	email_d:	E-Mail entered by user AS IS, by descriptor
**	password_d:	Password string, by descriptor
**
**  RETURN VALUE:
**
**      VMS Condition code.
**
**--
*/

const struct 	{
	short	proto;
	char	type;
	char	domain;
	} sck_parm = {INET$C_UDP,INET_PROTYP$C_DGRAM,INET$C_AF_INET};

int	pmas_user_authenticate	(
	struct dsc$descriptor	*email_d,
	struct dsc$descriptor	*password_d
				)
{
int	status,i,len,retry,tmo,delta_tmo[2],ipaddr,reqidt = 0;
unsigned char	obuf [256],ibuf[1024],secret[64];
unsigned short buflen,secretlen,port,hostlen = 0;
static short	chan;

const struct sockaddr_in sock_host = {INET$C_AF_INET,0,INET$C_INADDR_ANY,0};

ILE2	loc_host = {sizeof(struct sockaddr_in),0,&sock_host};
ILE3	rem_host = {sizeof(struct sockaddr_in),0,&sock_host,&hostlen},
		itmlst[] = {{sizeof(obuf),LNM$_STRING,obuf,&buflen},{0,0,0,0}};

iosb	netiosb;
unsigned char	vector[RAD$K_VECTORSZ],hash[RAD$K_VECTORSZ],*ptr;
RADPKT	*auth_req = (RADPKT *) obuf,*auth_ans = (RADPKT *) ibuf;


	/*
	** Get parameters from logicals
	*/
	if ( !(1 & (status = sys$trnlnm (0,&dsc_table,&dsc_radauth_addr,0,&itmlst))) )
		return	status;
	obuf[buflen] = '\0';
	if ( -1 == (ipaddr = inet_addr(obuf)) )
		return	SS$_INSFARG;

	if ( !(1 & (status = sys$trnlnm (0,&dsc_table,&dsc_radauth_port,0,&itmlst))) )
		port = RAD$K_AUTHUDPPORT;
	else if ( !lib$cvt_dtb(buflen,obuf,&port) )
		return	SS$_INSFARG;

	if ( !(1 & (status = sys$trnlnm (0,&dsc_table,&dsc_radretry,0,&itmlst))) )
		retry = 5;
	else if ( !lib$cvt_dtb(buflen,obuf,&retry) )
		return	SS$_INSFARG;

	/*
	** If timeout value is not specified use 5 seconds
	*/
	if ( !(1 & (status = sys$trnlnm (0,&dsc_table,&dsc_radtmo,0,&itmlst))) )
		tmo = 5;
	else if ( !lib$cvt_dtb(buflen,obuf,&tmo) )
		return	SS$_INSFARG;

	i = LIB$K_DELTA_SECONDS;
	if ( !(1 & (status = lib$cvt_to_internal_time(&i,&tmo,delta_tmo))) )
		return	status;

	if ( !(1 & (status = sys$trnlnm (0,&dsc_table,&dsc_secret,0,&itmlst))) )
		return	status;
	memcpy(secret,obuf,buflen);
	secretlen = buflen;

	/*
	** Initialize network stuff
	*/
	if ( !(1 & (status = sys$assign( &dsc_ucxdev,&chan,0,0))) )
		{
		if ( status != SS$_NOSUCHDEV )
			return  status;
		if ( !(1 & (status = sys$assign( &dsc_tcpipdev,&chan,0,0))) )
			return  status;
		}

	/*
	** Create a UDP device
	*/
	sock_host.sin_family = INET$C_AF_INET;
	status = sys$qiow (EFN$C_ENF,chan,IO$_SETMODE,&netiosb,
				0,0,&sck_parm,0,&loc_host,0,0,0);

	if ( !(status & 1) )
		{
		sys$dassgn (chan);
		return	status;
		}
	if ( !(netiosb.iosb$w_status & 1) )
		{
		sys$dassgn (chan);
		return	netiosb.iosb$w_status;
		}
	
	sock_host.sin_addr.s_addr = ipaddr;
	sock_host.sin_port = htons(port);

	/*
	** Prepare AUTH/REQUEST packet
	*/
	if ( !(1 & (status = sys$create_uid(&auth_req->radpkt$b_vector))) )
                lib$signal(status);

	md5_calc1(hash,secret,secretlen,auth_req->radpkt$b_vector,RAD$K_VECTORSZ);

	/*
	** Fill header
	*/
	auth_req->radpkt$b_code	= RADREQ$K_AUTHREQ;
	auth_req->radpkt$b_id	= (unsigned char) rand();
	ptr = (unsigned char *) &auth_req->radpkt$r_avp;
	len = RADPKT$K_HDRSZ;

	/*
	** Username = <email_d>
	*/
	*ptr++ = ATTR$K_USER;
	*ptr++ = (unsigned char) (email_d->dsc$w_length + 2);
	memcpy(ptr,email_d->dsc$a_pointer,email_d->dsc$w_length);
	len   += email_d->dsc$w_length + 2;

	ptr   += email_d->dsc$w_length;

	/*
	** NAS-Identifier = PMAS
	*/
	*ptr++ = ATTR$K_NAS_ID;
	*ptr++ = (unsigned char) (4 + 2);
	*ptr++ = 'P'; *ptr++ = 'M'; *ptr++ = 'A'; *ptr++ = 'S';
	len   += 4 + 2;

	/*
	** Hash the password with a shared secret, and put it into the packet
	*/
	*ptr++ = ATTR$K_PASS;
	*ptr++ = RAD$K_CHUNKSZ + 2;
	len   += RAD$K_CHUNKSZ + 2;
	for (i = 0;i < min(password_d->dsc$w_length,RAD$K_CHUNKSZ);i++)
                *ptr++ = hash[i] ^ password_d->dsc$a_pointer[i];
	for (;i < RAD$K_CHUNKSZ;i++)
                *ptr++ = hash[i] ^ 0;


	auth_req->radpkt$w_len	= (unsigned short) htons(len);

	/*
	** Send REQUEST & waiting ACK/REJECT
	*/
	reqidt = chan;
	for (i = 0;i < retry;i++)
		{
		/*
		** Queue the read request
		*/ 
		if ( !(1 & (status = sys$qiow (EFN$C_ENF,chan,IO$_WRITEVBLK,&netiosb,0,0,
                                        &obuf,len,&rem_host,0,0,0))) )
			break;

		/*
		** Prepare to timeout processing
		*/
		if ( !(1 & (status = sys$setimr(EFN$C_ENF, &delta_tmo,timer_ast,&reqidt,0))) )
			break;

		/*
		** Wait for an answer to request from RADIUS server
		*/ 
		if ( !(1 & (status = sys$qiow (EFN$C_ENF,chan,IO$_READVBLK,&netiosb,0,0,
                                        &ibuf,sizeof(ibuf),&rem_host,0,0,0))) )
			break;

		/*
		** Check status, byte count, and remote IP address 
		*/
		if ( netiosb.iosb$w_bcnt && (netiosb.iosb$w_status & 1) &&
			(auth_ans->radpkt$b_id == auth_req->radpkt$b_id) &&
			sock_host.sin_addr.s_addr == ipaddr )
			break;
		}

	sys$cantim(&reqidt,0);
	sys$dassgn (chan);

	/*
	** If have not got an answer from a remote RADIUS then performs checking against
	** a local SYSUAF
	*/
	if ( !netiosb.iosb$w_bcnt || !(netiosb.iosb$w_status & 1) )
		return	SS$_TIMEOUT;

	/*
	** Processing ACK/REJECT
	*/
	if ( auth_ans->radpkt$b_code != RADREQ$K_AUTHACK )
		return	SS$_INVLOGIN;


	/*
	** Check digest of the received packet
	*/
	len = netiosb.iosb$w_bcnt;
	memcpy(vector,auth_ans->radpkt$b_vector,RAD$K_VECTORSZ);
	memcpy(auth_ans->radpkt$b_vector,auth_req->radpkt$b_vector,RAD$K_VECTORSZ);

	md5_calc1(hash,ibuf,len,secret,secretlen);

	if ( memcmp(vector,hash,RAD$K_VECTORSZ) )
		return	SS$_INVLOGIN;

	return	SS$_NORMAL;
}