Article 4671 of vmsnet.internals:
In article <009A29D7.89F1B073.177@bridge.anglia.ac.uk>, "Ian Kitching, System Manager" <systimk@bridge.anglia.ac.uk> writes:
> I finally got around to writing IDENTD as a small Macro32 program -
> for VMS V5.5/UCX V3.1 but presumably will recompile happily for later
> versions.
> 
> It's very much a V1 effort, e.g. could be made properly multithreaded.
> 
> It's available here:
> 
>   ftp://ftp.anglia.ac.uk/identd.mar
> = http://bridge.anglia.ac.uk/ftp/identd.mar

The ftp: url is good but the http gives "access to object ruled out"

I've posted this before but here's an example of a minimal functional
identd server written entitely in DCL:

$! identd.com
$! A rapidly knocked together identd server for UCX( RFC 1413)
$! No real sanity checking is done on the input and this
$! isn't intended as an example of DCL good progamming style.
$! Just a proof of concept... Tested under UCX 3.3
$!
$! Inspired by Stellan Lagerström's <stellanl@e.kth.se> identd.pas
$!
$! Alan Greig <agreig@tay.ac.uk> Dec 1995
$!
$! This procedure must
$! Be woken up by AUXS server on port 113
$! Read a net connection of the form
$! server_socket , client_socket
$! UCX SHO DEV/PORT=server_socket
$! parse returnded device name (bgnnnn)
$! f$getdvi("devnam","pid")
$! f$getjpi(devpid,"username")
$! write sys$net server_socket , " , ",client_socket, " : ", "USERID : VMS : ", -
$! devuser
$! close connection
$! exit
$! error:
$! write sys$net server_socket , " , ",client_socket, " : ", "ERROR : NO-USER"
$!
$! 
$! The service is setup via the following commands. In a real production
$! version the server should probably have its own username set up
$! along the lines of (say UCX_LPD) with appropriate priveleges (WORLD)
$! You probably don't want to log everything either.
$! UCX SET SERVICE IDENTD -
$!   /PORT=113/PROTO=TCP/PROCESS=UCX_IDENTD/USER=username -
$!   /FILE=userdir:IDENTD.COM -
$!   /LOG=(file:userdir:IDENTD.LOG,all)
$! UCX ENABLE SERVICE IDENTD
$! UCX SET CONFIG ENABLE SERVICE IDENTD
$!
$ set noverify ! verify if debugging
$ set proc/priv=all ! Only world actually needed.
$! pid = f$getjpi("0","PID")
$ pid = "debug"
$! next line normally should be executed at end of procedure but
$! debug mode (pid=debug) will leave scratch file sitting about until next
$! execution.
$ delete/nolog sys$sysdevice:[agreig.identd]identd_'pid'.tmp.*
$ open/read/write net sys$net
$! open/read/write net sys$output ! Debugging interactively
$ open/write log sys$sysdevice:[agreig.identd]identd_connections.log
$ write log f$fao("!AS!%D", "Connection received at ",0)
$! write net f$fao("!/") ! say hello
$ socket_pair = ""
$ buff2 = ""
$! append returned data from read until a control character other
$! than tab seen.
$rd:
$ read/error=error net buffer
$!
$! debugging interactively
$! write sys$output buffer
$! socket_pair = buffer
$! goto rd_fin
$!
$ i=0
$rd2:
$ c = f$extract(i,1,buffer)
$ if c .eqs. "	" then c = " "	!convert tab to space
$ if c .lts. " " .or. c .gts. "z" then goto rd_done
$ buff2 = buff2 + c
$ i=i+1
$ if i .lt. f$length(buffer) then goto rd2 ! More data in this buffer
$ goto rd ! buffer empty - get another
$!
$rd_done:
$ socket_pair = buff2
$! write sys$output socket_pair
$ server_socket = f$element(0,",",socket_pair)
$ server_sockint = f$integer(server_socket)
$ client_socket = f$element(1,",",socket_pair)
$ client_sockint = f$integer(client_socket)
$ write log socket_pair 
$! write sys$output "Server socket: ",server_sockint, " Client : ",client_sockint
$ define/user sys$output sys$sysdevice:[agreig.identd]identd_'pid'.tmp
$ UCX SHO DEV/PORT='server_socket'
$! Now need to parse the UCX SHOW DEV output. This better not change...
$!
$ on error then goto ucxend
$ open/read ucxfile sys$sysdevice:[agreig.identd]identd_'pid'.tmp
$! Skip header lines
$ read ucxfile ucxline
$ucxlp:
$ read/end=ucxend ucxfile ucxline
$! write sys$output ucxline, f$fao("!/")
$ ucxdevice = f$extract(2,10,ucxline)
$ ucxclient_socket = f$extract(31,5,ucxline)
$ ucxclient_sockint = f$integer(ucxclient_socket)
$ ucxrem_host = f$extract(55,f$length(ucxline)-54,ucxline)
$! write sys$output ucxdevice,ucxclient_socket,ucxclient_sockint,ucxrem_host
$ if ucxclient_sockint .ne. client_sockint then goto ucxlp
$! Found a match
$ on warning then goto error
$ ucxdevice = f$element(0," ",ucxdevice)
$ userpid = f$getdvi(ucxdevice,"PID")
$ username = f$getjpi(userpid,"USERNAME")
$ write log ucxrem_host
$ write log socket_pair, " : USERID : VMS : ", username
$ write net socket_pair, " : USERID : VMS : ", username, f$fao("!/")
$ goto finish
$!
$! exit
$!
$error:
$ucxend:
$ on error then goto finish
$ write log socket_pair, " : ERROR : NO-USER" 
$ write net socket_pair, " : ERROR : NO-USER" ,f$fao("!/")
$finish:
$ set noon
$ close net
$ close ucxfile
$ close log
$! delete/nolog sys$sysdevice:[agreig.identd]identd_'pid'.tmp.*
$ wait 00:00:01 !perhaps not needed.
$ exit


> 
> Ian Kitching
> systimk@bridge.anglia.ac.uk
> http://bridge.anglia.ac.uk/~systimk/
-- 
Alan Greig                           Tel: (01382) 308802
University of Abertay Dundee       Email: A.Greig@tay.ac.uk
   ** Never underestimate the power of human stupidity **


