Apache-NNTPGateway
view release on metacpan or search on metacpan
NNTPGateway.pm view on Meta::CPAN
#!/usr/local/bin/perl -w --
# ------------------------------------------------------------------------
# Apache/NNTPGateway.pm: Apache mod_perl Handler.
# - Web Interface to NNTP. The complete pod doc is at the __END__.
# ------------------------------------------------------------------------
package Apache::NNTPGateway;
my ($NAMETAG) = __PACKAGE__ =~ /::(.*)$/;
require 5.00502;
use strict;
#use warnings;
use vars qw($VERSION $DEBUG $NNTP);
$VERSION = '0.9';
# Needed packages
use Apache::Constants qw(:common);
use Apache::URI qw();
use Apache::Request qw();
use Apache::Log qw();
#use CGI qw/:standard/;
use CGI::Cookie qw();
# Net::NNTP @ISA Net::Cmd, IO::Socket
use IO::Socket;
use Net::Cmd qw(CMD_REJECT CMD_ERROR);
use Net::NNTP qw();
use Net::Config qw();
use Net::Domain qw();
use Mail::Address qw();
#use HTML::Template;
use File::Spec qw();
# Configurable Variables -------------------------------------------------
$DEBUG = 0;
# This variable is a protection against installing this handler in an
# unwanted Location. If set, the URL of the request is matched against
# this var and the handler continue processing only if the match
# succeed. Check get_config() sub for more details.
my $REQUIRED_LOCATION_BASE_RE = undef;
# The default NNTP server used, on correctly configured systems, with
# correctly configured Net modules, this should be ok, but this could
# be overridden by a server config NNTPGatewayNewsServer anyway.
my $DEFAULT_NEWS_SERVER = $Net::Config::NetConfig{nntp_hosts}->[0] || 'newsserver';
####
## You should have nothing to modify below this line... except maybe in
## the MESSAGES or HTML DECORATIONS sections.
####
# Garbage cans
my @_dummy_;
my $_dummy_;
my $DOMAIN_NAME = &Net::Domain::hostdomain() || $Net::Config::NetConfig{inet_domain};
if ( defined $DOMAIN_NAME && $DOMAIN_NAME ne '' ) {
($DOMAIN_NAME, @_dummy_) = split ':', $DOMAIN_NAME;
}
my $COOKIE_DOMAIN = $DOMAIN_NAME;
my $SERVER_NAME = 'www';
# NOT YET IMPLEMENTED!
# Server Root relative directory containing HTML Templates files,
# could be overridden by Directory config NNTPGatewayTemplatesDir.
my $DEFAULT_TEMPLATES_DIR = "lib/templates/${NAMETAG}";
# See Actions_Map.
my $DEFAULT_ACTION_NAME = 'last';
# If you badly configure this module here is what will be shown in the
# Organisation field of your posts ... nice!?
my $DEFAULT_ORGANIZATION = 'The Disorganized Corp';
# HTML DECORATIONS
my $HTML_DTD = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">";
NNTPGateway.pm view on Meta::CPAN
(
'list' => \&action_list,
'last' => \&action_last,
'read' => \&action_read,
'followup' => \&action_followup,
'post' => \&action_post,
'catchup' => \&action_catchup,
);
# Action shown in main menu
my %Menu_Entries_Map =
(
'list' => 1,
'last' => 1,
'post' => 1,
);
# Action that are posting actions....
my %Post_Actions_Map =
(
'post' => 1,
'followup' => 1,
);
# Unauthorized actions (configurable).
my %Disabled_Actions = ();
# Headers shown in headers=min
my %Used_Headers_Map =
(
'from' => 1,
'date' => 1,
'subject' => 1,
);
# Anonymous posters map (configurable).
my %Anonymous_Posters =
(
'anonymous' => 'Anonymous',
);
# Run time global vars:
# All keys are lowercase: see get_args()...
my $Args = {};
# Populated by get_config() ....
my %From_Posters = ();
my $The_Action = $DEFAULT_ACTION_NAME;
my $Title = $PKG_NAME;
my $NNTP_Server = $DEFAULT_NEWS_SERVER;
my $The_Newsgroup = undef;
my $The_GroupDescription = undef;
my $NewsUrl = "news://$NNTP_Server/$The_Newsgroup";
my $Base = '/';
my $StyleSheet = '';
my $Anonymous_Post_Allowed = 0;
my $Organization = $DEFAULT_ORGANIZATION;
my $Templates_Dir = $DEFAULT_TEMPLATES_DIR;
my $Catchup_Cookie_Name = undef;
my $The_User = '';
# Subs decl --------------------------------------------------------------
sub handler ( $ );
sub action_list ( $ );
sub action_catchup ( $ );
sub action_last ( $\$ );
sub action_read ( $\$$ );
sub action_followup ( $\$ );
sub action_post ( $ );
sub print_html_article ( $$\$$$ );
sub print_html_article_menu ( $$\$ );
sub print_html_list_menu ( $$ );
sub print_html_post_form ( $\$$$ );
sub print_html_head ( $\@ );
sub print_html_foot ( $ );
sub print_html_menu ( $\$ );
sub print_html_error ( $\$$$ );
sub to_html ( $ );
sub nntp_connect ( $ );
sub nntp_post_article ( $$$\$ );
sub nntp_get_article ( $\$ );
sub print_nntp_error ( $$ );
sub get_args ( $ );
sub get_config ( $ );
sub check_user ( $ );
sub message ( $\@ );
sub is_true ( $ );
sub is_false ( $ );
sub parse_from ( $ );
# The Apache mod_perl handler --------------------------------------------
sub handler ( $ ) {
# using Apache::Request is better ...
my $r = Apache::Request->new(shift);
# Do not bother with HEAD requests
return DECLINED if $r->header_only();
# Do not bother with internal sub-requests
return DECLINED unless $r->is_main();
# Configuration tell to Stop it now ...
return DECLINED if &is_true( $r->dir_config( 'NNTPGatewayStop' ));
# Get misc args && config
return SERVER_ERROR unless &get_config( $r );
return SERVER_ERROR unless &get_args( $r );
# Check username ... The handling and printing of possible errors is
NNTPGateway.pm view on Meta::CPAN
$Args->{first_art} = $catchupid +1;
}
}
my $first_art = $Args->{first_art};
my $last_art = $Args->{last_art};
my $n_arts = ($last_art - $first_art) +1;
$r->log->notice( "Listing $n_arts articles from $first_art to $last_art..." ) if $DEBUG;
if ( $n_arts > 0 ) {
# Some articles to display...
&print_html_list_menu( $r, $n_arts );
$r->print( "\n<hr noshade>\n" );
my $i = $first_art;
for ( ; $i <= $last_art; $i++ ) {
# All articles are got now one by one from the newsserver,
# remember this is not a real newsreader we will not build
# threads trees here we've no time for that. But a powerful
# patch to do that will be welcome anyway ;-)
my $Article = &nntp_get_article( $i, 1 );
if ( $Article ) {
&print_html_article( $r, $Article, 1, &is_true( $Args->{long} ));
} else {
$r->print( "<span id=\"bad_id\"><strong>", &message('no_id', $i ), "</strong></span><br>\n" );
}
}
# Print the list menu
$r->print( "\n<hr noshade>\n" );
&print_html_list_menu( $r, $n_arts );
} else {
# No articles to display...
&print_html_list_menu( $r, $n_arts );
}
# Print global menu
&print_html_menu( $r );
# Print html footer
&print_html_foot( $r );
return;
} # end action_list();
### Sub action_catchup() ###
# &action_catchup( request ):
# - Description: Mark all articles in the group as read.
# - Arguments : the Apache request
###
sub action_catchup ( $ ) {
my ($r) = @_;
# Prepare catchup...
my $catchupid = $Args->{last_art};
my $catchupdate = $NNTP->date();
my $newnewsok = $NNTP->newnews( $catchupdate, $The_Newsgroup )?1:0;
# Build the catchup cookie
my $cookie = new CGI::Cookie
(
-name => $Catchup_Cookie_Name,
-value => "Id=${catchupid},Date=${catchupdate}",
# 10 years should be enough as expiration date.
-expires => '+10y',
-domain => $COOKIE_DOMAIN,
-path => $Base
);
$r->header_out( 'Set-Cookie' => $cookie );
# Print html header
&print_html_head( $r, 1 );
# Print menu
&print_html_menu( $r );
$r->print( "\n<hr noshade>\n" );
# Just Inform user
$r->print
(
"<h2 align=\"center\">${NewsUrl}<br>\n<font color=\"red\">",
&message( 'catchup_at', scalar( localtime( $catchupdate ))),
"</font></h2>\n",
"<div align=\"center\">[<a href=\"${Base}/list?force=1\">",
&message( 'list_all' ),
"</a>]</div>\n"
);
# Print menu
$r->print( "\n<hr noshade>\n" );
&print_html_menu( $r );
# Print html footer
&print_html_foot( $r );
return;
} # end action_catchup();
### Sub action_last() ###
# &action_last( request [, force] ):
# - Description: Print last article in the group.
# - Arguments : the Apache request
###
sub action_last ( $\$ ) {
my ($r, $force) = @_;
my $id_last = $Args->{last_art};
# Everything is handled by action_read with ID of last article. And
# as last article could always change caching is not allowed.
&action_read( $r, $id_last, 1 );
return;
} # end action_last();
### Sub action_read() ###
# &action_read( request [, id, no-cache] ):
# - Description: Print article given it's Id.
# - Arguments : the Apache request, article id to read
###
sub action_read ( $\$$ ) {
my ($r, $id, $no_cache ) = @_;
# Get id of article to read
my $args = $Args->{action_args};
if ( $args && @$args ) {
# id of article to read
$id ||= $args->[0];
} else {
$id ||= $Args->{last_art};
}
NNTPGateway.pm view on Meta::CPAN
my $body = $NNTP->body( $id );
my $b = '';
if ( @$body ) {
$b = join( '', @$body );
# Try to extract Signature ...
my ($b2, $s) = $b =~ /^(.*)[\s\n]*\n+-{2,3}[ \t\r\f]*\n+(.*)/sm;
if ( $b2 && $s ) {
$b = $b2;
# Made texts links in signature to clickable links
$s =~ s/(\w+:\/\/\S+)/<a href=\"$1\" target=\"_top\">$1<\/a>/sgm;
$s =~ s/\s((www|w3)\.[a-z0-9][a-z0-9\.]?\.[a-z]{2,3})\b/<a href=\"http:\/\/$1\/\" target=\"_top\">$1<\/a>/isgm;
$s =~ s/\s+$//;
$Article{Signature} = $s;
}
} else {
$b = &message( 'no_body' );
}
# Made texts links in body to clickable links
$b =~ s/(\w+:\/\/\S+)/<a href=\"$1\" target=\"_top\">$1<\/a>/sgm;
$b =~ s/\s((www|w3)[-a-z_]*\.[a-z0-9][-a-z0-9_\.]?\.[a-z]{2,3})\b/<a href=\"http:\/\/$1\/\" target=\"_top\">$1<\/a>/isgm;
$Article{Body} = $b;
}
$Article{Id} = $id;
$Article{Header}{subject} = &message( 'no_subject' ) unless $Article{Header}{subject};
return \%Article;
} # end nntp_get_article();
### Sub print_nntp_error() ###
# &print_nntp_error( request, error ):
# - Description:
# - Arguments :
# - Return :
###
sub print_nntp_error ( $$ ) {
my ($r, $err) = @_;
$r->log->warn( "${Base} NNTP Error: $err" );
&print_html_head( $r );
&print_html_error( $r, "NNTP Error \@ $NewsUrl", $err );
$r->print
(
"<div align=\"center\"><font color=\"red\">",
"[<a href=\"", $r->subprocess_env('SCRIPT_URL'), "\">", &message('try_again'), "</a>]",
"</font></div>\n",
);
&print_html_foot( $r );
return;
} # end print_nntp_error();
# Utilities ---------------------------------------------------------
### Sub get_args() ###
# status = &get_args( request ):
# - Description: Fill in the global hash Args. The args are processed
# in this order: Cookies, path_info, environment variables, GET then
# POST args, each arg overriding previous one if already defined.
# - Arguments : the Apache request
# - Return : 1=ok, 0=failure
###
sub get_args ( $ ) {
my $r = shift;
# Empty Args...
$Args = {};
# Get cookies vals
my %cookies = CGI::Cookie->parse( $r->header_in('Cookie'));
my $catchupval = $cookies{$Catchup_Cookie_Name}->value() if $cookies{$Catchup_Cookie_Name};
$r->log->notice( "Got cookie $Catchup_Cookie_Name: $catchupval" ) if $DEBUG;
# See action_catchup for settings of cookies
if ( $catchupval =~ /^(Id)=(\d+),\s*(Date)=(\d+)$/ ) {
$Args->{catchup_id} = $2;
$Args->{catchup_date} = $4;
}
# Parse path_info to get the action and such ...
my $pi = $r->path_info();
$pi =~ s/^\/*//;
$Args->{action} = undef;
$Args->{action_args} = undef;
if ( $pi ) {
my ($action, @rest) = split( '/', $pi );
$Args->{action} = lc( $action ) if $action;
$Args->{action_args} = \@rest if ( $action && @rest );
}
# Get misc useful environment variables. TODO This really needs
# improvements. If anybody have a good idea on how to do it, thanks!
my $L = $r->subprocess_env('LANG') || $r->subprocess_env('USR_LANG') || $USR_LANG;
$L = lc( $L );
$USR_LANG = $L if ( $LANGS_OK{$L} );
$Args->{lang} = $USR_LANG;
# Get args from POST or GET (?args=xxx)
#$r->log->info( "Reading POST&GET content ..." ) if $DEBUG;
my %A = ($r->args(), $r->content());
map{ $Args->{lc($_)} = $A{$_} } keys %A;
# that's all folks ...
map{ $r->log->info( "Arg \'$_\': \"", $Args->{$_}, "\"" ) } keys %{$Args} if $DEBUG;
return 1;
} # end get_args();
### Sub get_config() ###
# status = &get_config( request ):
# - Description: Read the configuration instructions.
# - Arguments : the Apache request
# - Return : 1=ok, 0=failure
###
sub get_config ( $ ) {
my $r = shift;
$DEBUG = &is_true( $r->dir_config( 'NNTPGatewayDebug' ));
# Server config
$Base = $r->location();
# I'm not really sure I should keep this protection ...
if ( $REQUIRED_LOCATION_BASE_RE && $Base !~ /^$REQUIRED_LOCATION_BASE_RE/o ) {
$r->log_error( "$PKG_NAME called from $Base but only permitted from /^$REQUIRED_LOCATION_BASE_RE/" );
return 0;
}
$SERVER_NAME = $r->subprocess_env('HTTP_HOST') || $r->subprocess_env('SERVER_NAME') || $SERVER_NAME;
if ( $SERVER_NAME =~ /^([^\.]+)\.(.*)/ ) {
$COOKIE_DOMAIN = $DOMAIN_NAME = $2;
} else {
$DOMAIN_NAME ||= $SERVER_NAME;
$COOKIE_DOMAIN = undef;
}
# Apache Config directive - PerlSetVar -
$The_Newsgroup = $r->dir_config( 'NNTPGatewayNewsGroup' );
unless ( $The_Newsgroup ) {
# NewsGroup is a required config parameter
$r->log_error( "Configuration directive NNTPGatewayNewsGroup should be set in <Location $Base>!" );
return 0;
}
$The_GroupDescription = $r->dir_config( 'NNTPGatewayGroupDescription' ) || ' ';
$NNTP_Server = $r->dir_config( 'NNTPGatewayNewsServer' ) || $DEFAULT_NEWS_SERVER;
$NewsUrl = "news://${NNTP_Server}/${The_Newsgroup}";
$DEFAULT_ACTION_NAME = $r->dir_config( 'NNTPGatewayDefaultAction' ) || $DEFAULT_ACTION_NAME;
$Catchup_Cookie_Name = 'NNTPGatewayCatchup.' . $The_Newsgroup;
$Organization = $r->dir_config( 'NNTPGatewayOrganization' ) || $Organization;
$Title = $r->dir_config( 'NNTPGatewayTitle' ) || "NNTPGateway: $NewsUrl";
$StyleSheet = $r->dir_config( 'NNTPGatewayStyleSheet' ) || undef;
# Anonymous posts configuration
$Anonymous_Post_Allowed = &is_true( $r->dir_config( 'NNTPGatewayAnonymousPostAllowed' )) || 0;
if ( $Anonymous_Post_Allowed ) {
# Get a list of anonymous posters names if any,
# AnonymousPosters mail1=Name 1, name2=Name 2, ...
my $anon_names = $r->dir_config( 'NNTPGatewayAnonymousPosters' );
$r->log->info( "AnonymousPosters: $anon_names" ) if $DEBUG;
foreach ( split( /,/, $anon_names )) {
my ($m, $n) = split( /=/, $_ );
$m = lc( $m );
$Anonymous_Posters{$m} = $n unless exists $Anonymous_Posters{$m};
}
} else {
# No anonymous posters
%Anonymous_Posters = ();
}
# Get the list of all disabled actions
%Disabled_Actions = ();
my $disabled = lc( $r->dir_config( 'NNTPGatewayDisabledActions' ));
if ( $disabled eq 'none' ) {
$r->log->warn( "DisabledActions: none" );
} elsif ( $disabled ) {
$r->log->info( "DisabledActions: \"$disabled\"" ) if $DEBUG;
my @disabled = split( /([\s,])/, $disabled );
foreach ( @disabled ) {
my $a = $_;
$Disabled_Actions{$a} = 1 if $Actions_Map{$a};
}
} else {
$r->log->notice( "DisabledActions: none" );
}
# NYI: Get directory where to find HTML::Template files. This
# feature is not yet implemented but hope it will be soon...
my $tmpldir = $r->dir_config( 'NNTPGatewayTemplatesDir' ) || $DEFAULT_TEMPLATES_DIR;
# Append server root to it
$tmpldir = $r->server_root_relative( $tmpldir ) unless File::Spec->file_name_is_absolute( $tmpldir );
# Canonize dir name
$Templates_Dir = File::Spec->canonpath( $tmpldir );
unless ( -d $Templates_Dir ) {
#$r->log_error( "Templates dir $Templates_Dir not found!" );
#return 0;
}
#$r->log->info( "Using templates from dir $Templates_Dir ..." ) if $DEBUG;
return 1;
} # end get_config();
### Sub check_user() ###
# status = &check_user( request ):
# - Description: Check username..., via ident 1st then w/ http loggin...
# This function need still a lot of work.
NNTPGateway.pm view on Meta::CPAN
my $from = shift;
my $addr = (Mail::Address->parse($from))[0] || return ();
return ($addr->address(), $addr->name());
} # end parse_from();
1;
__END__
# Documentation ----------------------------------------------------------
=head1 NAME
B<Apache::NNTPGateway> - A NNTP interface (Usenet newsgroups) for
mod_perl enabled Apache web server.
=head1 SYNOPSIS
You must be using mod_perl, see http://perl.apache.org/ for details.
For the correct work your apache configuration should contain apache
directives look like these:
In httpd.conf (or any other apache configuration file):
<Location "/path/to/newsgroup">
SetHandler perl-script
PerlHandler Apache::NNTPGateway
PerlSetVar NNTPGatewayNewsGroup "newsgroup"
PerlSetVar NNTPGateway... (see L<CONFIGURATION> Directives)
</Location>
=head1 DESCRIPTION
This module implements a per group interface to NNTP (Usenet) News-Groups, it
allow users to list, read, post, followup ... articles in a given
newsgroup/newsserver depending of configuration. This is not a replacement
for a real powerful newsreader client but just pretend to be a simple, useful
mapping of some news articles into a web space.
=head2 ACTIONS
Here is the list of all actions that can be performed on the current newsgroup.
=over 4
=item list
List articles, all articles from the current newsgroup or only unread
articles if the user/client already did a B<catchup>.
=item catchup
Mark all current articles as read. This use a Cookie.
=item last
Read the last article available from the newsserver.
=item read
Read article by ID.
=item followup
Post a followup to an article.
=item post
Post an new article to the current newsgroup.
=back
=head1 CONFIGURATION
Except some very few optional adjustments in the module source itself all
configuration is done with B<PerlSetVar> directives in Apache configurations
files.
=head2 Directives
All following features of this PerlHandler, will be set in the apache
configuration files. For this you can use PerlSetVar apache directive.
=over 4
=item NNTPGatewayNewsGroup
(string, B<mandatory>)
The newsgroup used for the current NNTPGateway location. Not setting this
will make NNTPGateway fail.
=item NNTPGatewayGroupDescription
(string, I<optional>)
Short description (1 or 2 lines) of what this newsgroup is for/contain.
=item NNTPGatewayStop
(boolean, I<optional>)
Tell to completely disable NNTPGateway, useful for temporary maintenance.
=item NNTPGatewayDefaultAction
(ACTION name, I<optional>) Default value: B<last>
Default action used when nothing specified. (see L<ACTIONS>).
=item NNTPGatewayNewsServer
NNTPGateway.pm view on Meta::CPAN
ServerRoot relative Directory where to find HTML templates files (not yet Implemented).
=item NNTPGatewayDebug
(boolean, I<optional>) Default value: B<off>
Set this to debug NNTPGateway.
=back
=head1 SECURITY
If you B<allow> Anonymous posting absolutely no security checks are
performed unless you protect access to the Location this handler is located
on, but that is not the job of this module.
If you B<deny> Anonymous posting, the handler will check B<remote_ident>
(via Identd) or B<remote_user> and will check if they are valid username by
checking C<getpwnam()> (a list of some generic usernames such as: root,
anonymous ... are not considered as valid too, even if they are), if
directive B<NNTPGatewayNonLocalPostOk> had not been set, if they are not
they are rejected, if they are they could post and the From header will be
set to that username. That is the only security check the handler will do,
it is up to other apaches modules to correctly protect the Location and set
valid usernames (enable identd or loggin via AuthNIS or anything else).
Furthermore the webmaster could disable the use of some actions such as
post, followup ...
=head1 BUGS
The connection to the nntp server is handled in a global variable so that the
connection is common to all requests in the current apache child process. Due
to that, when the module is used with 2 differents configs (in 2 <Location
xxx>) setting 2 differents newsservers and that 2 requests are made in the
same child with these 2 configs (or more) ... the second request could re-use
a NNTP connection (open during the 1st request) already open to the B<first>
server. I do not want to make the nntp object a local variable, because the
connection is a long process ... But anyway, I have some few ideas of how to
solve the problem, but as I am lazy and my configuration do not have this
problem I am waiting for pressure from eventual module users ...;-)
=head1 Changes
=over 4
=item v0.9
* Article id or subject added to title in read.
* More CSS classes everywhere... read the sources.
* use Apache::Log qw(); to access to log functions.
* Makefile.PL improved to really check used modules versions.
* Call Net::Cmd functions in a clean manner to make perl 5.6 happy (end of
that Bareword "CMD_ERROR" install bug).
=item v0.8
* Cookie domain better handled for catchup.
* NNTPGatewayNewsGroupTest removed. Set up a new Location and set
NNTPGatewayNewsGroup to the test group and NNTPGatewayDebug on to achieve
the same functionality.
* Some more directives to control users checking
(NNTPGatewayUsersNamesCaseInsensitive, NNTPGatewayNonLocalPostOk).
* Some handling of Cache-Control.
* Made this module ready for my first CPAN contribution ;-)
** Cleaning source code.
** Cleaning Documentation.
** CPAN Enabled distrib (Makefile.PL, .tar.gz dist, README file, CPAN ID
...).
=item v0.7
* The configuration directive B<NNTPGatewayCatchupCookieName> do not exists anymore.
* Disconnections to news server start to be better handled.
=item v0.6
First public release
=back
=head1 TODO
=over 4
=item *
Safe sharing of the NNTP global.
=item *
Keeping into account the If-Modified-Since, Last-Modified and so on ... stuff.
=item *
Using an HTML Template system (maybe HTML::Template) instead of hard coded html.
=item *
Improving the LANG selection stuff (maybe adding a new configuration directive?)
=item *
Improving the C<check_user()> stuff for more security.
=item *
Integrating Jie Gao threaded view of articles list.
=item *
more stuff ...
=back
=head1 THANKS
Thanks a lot to these people for they help:
=over 4
=item * Jie Gao <J.Gao@isu.usyd.edu.au>
For his help to build a clean installation of the module.
=back
=head1 SEE ALSO
perl(1), mod_perl(3), Apache(3), Net::NNTP(3), Net::Domain(3),
Net::Config(3), rfc9771, getpwnam(3)
( run in 0.531 second using v1.01-cache-2.11-cpan-6aa56a78535 )