Patch for additional connection attributes in perl hooks

Erik Klavon erik at eriq.org
Tue Feb 4 01:10:16 UTC 2003


Greetings

Enclosed is a patch which provides all of the attributes available to
the external authentication mechanism to the nnrpd perl auth and
access hooks. Updated documentation is also provided.

Note that this patch assumes the application of a previous patch to
correct a documentation omission submitted today which, for
completeness, is included at the end of this email message.

Work on a similar patch for the python hooks is under way.

Erik

------------------ first patch -------------------------------

diff -ur inn/doc/pod/hook-perl.pod inn_perl/doc/pod/hook-perl.pod
--- inn/doc/pod/hook-perl.pod	Mon Feb  3 16:56:37 2003
+++ inn_perl/doc/pod/hook-perl.pod	Mon Feb  3 16:56:23 2003
@@ -361,18 +361,19 @@
         perl_auth: "/path/to/script/auth1.pl"
 
 The file given as argument to perl_auth should contain the same
-procedures as before. The global hash %attributes remains the
-same, except for the removal of the "type" entry which is no longer
-needed in this modification. The return array now only contains either
-two or three elements, the first of which is the NNTP return code. The
-second is an error string which is passed to the client if the error
-code indicates that the authentication attempt has failed. This allows
-a specific error message to be generated by the perl script in place of
-"Authentication failed". An optional third return element if present
-will be used to match the connection with the users: parameter in
-access groups and will also be the username logged. If this element is
-absent, the username supplied by the client during authentication will
-be used as was the previous behavior.
+procedures as before. The global hash %attributes remains the same,
+except for the removal of the "type" entry which is no longer needed
+in this modification and the addition of several new entries (port,
+intipaddr, intport) described below. The return array now only
+contains either two or three elements, the first of which is the NNTP
+return code. The second is an error string which is passed to the
+client if the error code indicates that the authentication attempt has
+failed. This allows a specific error message to be generated by the
+perl script in place of "Authentication failed". An optional third
+return element if present will be used to match the connection with
+the users: parameter in access groups and will also be the username
+logged. If this element is absent, the username supplied by the client
+during authentication will be used as was the previous behavior.
 
 The perl_access parameter (described below) is also new; it allows the
 dynamic generation of an access group for an incoming connection using
@@ -383,7 +384,7 @@
 
 The new functionality should provide all of the existing capabilities
 of the Perl hook, in combination with the flexibility of readers.conf
-and the use of other authentication and resolving programs.  To use an
+and the use of other authentication and resolving programs.  To use
 Perl authentication code that predates the readers.conf mechanism, you
 would need to modify the code slightly (see below for the new
 specification) and supply a simple readers.conf file.  If you don't want
@@ -397,7 +398,7 @@
 of what once required Perl can be done directly.)  Even if the
 functionality is not available directly, you may wish to write a new
 authenticator or resolver (which can be done in whatever language you
-prefer) to working in Perl.
+prefer to work in).
 
 
 =head1 Perl Authentication Support for nnrpd
@@ -417,13 +418,17 @@
 
 Provided the file loads without errors, auth_init() (if present) runs
 without fatal errors, and a Perl function authenticate() is defined,
-authenticate() will then be called. authenticate() takes
-no arguments, but it has access to a global hash %attributes which
-contains information about the connection as follows:
-C<$attributes{hostname}> will contain the hostname (or the IP address
-if it doesn't resolve) of the client machine, C<$attributes{ipaddress}>
-will contain its IP address (as a string), C<$attributes{interface}>
-contains the interface the client connected on, 
+authenticate() will then be called. authenticate() takes no arguments,
+but it has access to a global hash %attributes which contains
+information about the connection as follows: C<$attributes{hostname}>
+will contain the hostname (or the IP address if it doesn't resolve) of
+the client machine, C<$attributes{ipaddress}> will contain its IP
+address (as a string), C<$attributes{port}> will contain the client
+port (as an integer), C<$attributes{interface}> contains the hostname
+of the interface the client connected on, C<$attributes{intipaddr}>
+contains the IP address (as a string) of the interface the client
+connected on, C<$attributes{intport}> contains the port (as an
+integer) on the interface the client connected on,
 C<$attributes{username}> will contain the provided username and
 C<$attributes{password}> the password.
 
@@ -461,15 +466,19 @@
 When a perl_access: parameter is encountered, Perl is loaded (if it
 has yet to be) and the file given as argument is loaded as
 well. Provided the file loads without errors, and a Perl function
-access() is defined, access() will then be called. access() takes
-no arguments, but it has access to a global hash %attributes which
+access() is defined, access() will then be called. access() takes no
+arguments, but it has access to a global hash %attributes which
 contains information about the connection as follows:
 C<$attributes{hostname}> will contain the hostname (or the IP address
-if it doesn't resolve) of the client machine, C<$attributes{ipaddress}>
-will contain its IP address (as a string), C<$attributes{interface}>
-contains the interface the client connected on. If it is available,  
-C<$attributes{username}> will contain the provided username and domain
-(in username at domain form).
+if it doesn't resolve) of the client machine,
+C<$attributes{ipaddress}> will contain its IP address (as a string),
+C<$attributes{port}> will contain the client port (as an integer),
+C<$attributes{interface}> contains the hostname of the interface the
+client connected on, C<$attributes{intipaddr}> contains the IP address
+(as a string) of the interface the client connected on,
+C<$attributes{intport}> contains the port (as an integer) on the
+interface the client connected on, C<$attributes{username}> will
+contain the provided username and domain (in username at domain form).
 
 access() returns a hash, containing the desired access parameters and
 values.  Here is an untested example showing how to dynamically generate a
diff -ur inn/nnrpd/nnrpd.h inn_perl/nnrpd/nnrpd.h
--- inn/nnrpd/nnrpd.h	Sun Feb  2 16:58:25 2003
+++ inn_perl/nnrpd/nnrpd.h	Mon Feb  3 16:52:18 2003
@@ -268,8 +268,8 @@
 
 #ifdef  DO_PERL
 extern void loadPerl(void);
-extern void perlAccess(char *clientHost, char *clientIpString, char *serverHost, char *user, struct vector *access_vec);
-extern int perlAuthenticate(char *clientHost, char *clientIpString, char *serverHost, char *user, char *passwd, char *errorstring, char*newUser);
+extern void perlAccess(char *user, struct vector *access_vec);
+extern int perlAuthenticate(char *user, char *passwd, char *errorstring, char*newUser);
 extern void perlAuthInit(void);
 #endif /* DO_PERL */
 
diff -ur inn/nnrpd/perl.c inn_perl/nnrpd/perl.c
--- inn/nnrpd/perl.c	Sun Feb  2 16:58:25 2003
+++ inn_perl/nnrpd/perl.c	Mon Feb  3 16:52:18 2003
@@ -202,7 +202,7 @@
     PerlLoaded = true;
 }
 
-void perlAccess(char *clientHost, char *clientIP, char *serverHost, char *user, struct vector *access_vec) {
+void perlAccess(char *user, struct vector *access_vec) {
   dSP;
   HV              *attribs;
   SV              *sv;
@@ -216,9 +216,12 @@
   SAVETMPS;
 
   attribs = perl_get_hv("attributes", true);
-  hv_store(attribs, "hostname", 8, newSVpv(clientHost, 0), 0);
-  hv_store(attribs, "ipaddress", 9, newSVpv(clientIP, 0), 0);
-  hv_store(attribs, "interface", 9, newSVpv(serverHost, 0), 0);
+  hv_store(attribs, "hostname", 8, newSVpv(ClientHost, 0), 0);
+  hv_store(attribs, "ipaddress", 9, newSVpv(ClientIpString, 0), 0);
+  hv_store(attribs, "port", 4, newSViv(ClientPort), 0);
+  hv_store(attribs, "interface", 9, newSVpv(ServerHost, 0), 0);
+  hv_store(attribs, "intipaddr", 9, newSVpv(ServerIpString, 0), 0);
+  hv_store(attribs, "intport", 7, newSViv(ServerPort), 0);
   hv_store(attribs, "username", 8, newSVpv(user, 0), 0);
 
   PUSHMARK(SP);
@@ -311,7 +314,7 @@
     
 }
 
-int perlAuthenticate(char *clientHost, char *clientIpString, char *serverHost, char *user, char *passwd, char *errorstring, char *newUser) {
+int perlAuthenticate(char *user, char *passwd, char *errorstring, char *newUser) {
     dSP;
     HV              *attribs;
     int             rc;
@@ -330,9 +333,12 @@
     ENTER;
     SAVETMPS;
     attribs = perl_get_hv("attributes", true);
-    hv_store(attribs, "hostname", 8, newSVpv(clientHost, 0), 0);
-    hv_store(attribs, "ipaddress", 9, newSVpv(clientIpString, 0), 0);
-    hv_store(attribs, "interface", 9, newSVpv(serverHost, 0), 0);
+    hv_store(attribs, "hostname", 8, newSVpv(ClientHost, 0), 0);
+    hv_store(attribs, "ipaddress", 9, newSVpv(ClientIpString, 0), 0);
+    hv_store(attribs, "port", 4, newSViv(ClientPort), 0);
+    hv_store(attribs, "interface", 9, newSVpv(ServerHost, 0), 0);
+    hv_store(attribs, "intipaddr", 9, newSVpv(ServerIpString, 0), 0);
+    hv_store(attribs, "intport", 7, newSViv(ServerPort), 0);
     hv_store(attribs, "username", 8, newSVpv(user, 0), 0);
     hv_store(attribs, "password", 8, newSVpv(passwd, 0), 0);
     
diff -ur inn/nnrpd/perm.c inn_perl/nnrpd/perm.c
--- inn/nnrpd/perm.c	Sun Feb  2 16:58:25 2003
+++ inn_perl/nnrpd/perm.c	Mon Feb  3 16:52:18 2003
@@ -1562,7 +1562,7 @@
         
         access_vec = vector_new();
 
-        perlAccess(ClientHost, ClientIpString, ServerHost, uname, access_vec);
+        perlAccess(uname, access_vec);
         free(uname);
 
         access_realms[0] = xcalloc(1, sizeof(ACCESSGROUP));
@@ -2248,7 +2248,7 @@
                 free(script_path);
                 perlAuthInit();
           
-                code = perlAuthenticate(ClientHost, ClientIpString, ServerHost, username, password, errorstr, newUser);
+                code = perlAuthenticate(username, password, errorstr, newUser);
                 if (code == NNTP_AUTH_OK_VAL) {
                     /* Set the value of ubuf to the right username */
                     if (newUser[0] != '\0') {

------------------ second patch -------------------------------

--- hook-perl.pod       Mon Feb  3 10:00:58 2003
+++ new-hook-perl.pod   Mon Feb  3 10:10:43 2003
@@ -454,7 +454,9 @@
 A Perl script may be used to dynamically generate an access group
 which is then used to determine the access rights of the client. This
 occurs whenever the perl_access: is specified in an auth group which
-has successfully matched the client. 
+has successfully matched the client. Only one perl_access:
+statement is allowed in an auth group. This parameter should not be
+mixed with a python_access: statement in the same auth group.
 
 When a perl_access: parameter is encountered, Perl is loaded (if it
 has yet to be) and the file given as argument is loaded as


-- 
erik         | "It is idle to think that, by means of words, | Maurice
  kl at von     | any real communication can ever pass | Maeterlinck
    eriq.org | from one [human] to another." | Silence


More information about the inn-workers mailing list