[interchange-cvs] interchange - heins modified 4 files
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Sun Sep 1 09:14:02 2002
User: heins
Date: 2002-09-01 13:13:46 GMT
Modified: lib/Vend Config.pm Interpolate.pm Server.pm
Modified: scripts interchange.PL
Log:
* Add new content management features. This allows Interchange to:
-- Accept Apache error redirects, i.e. handle 404 errors
-- Initially process page, process page after variables, and
process page before image substitution with configurable subroutines
-- Take puts for DAV-style publishing
* New "AcceptRedirect" directive. If "Yes", will look for REDIRECT_URL,
REDIRECT_QUERY_STRING, etc. and use those to provide the request.
This allows:
ErrorDocument 404 /cgi-bin/foundation
At that point, a request for /index.html that is not found will
be equivalent to /cgi-bin/foundation/index.html and will be
indistinguishable from the real page by the client.
* New Pragmas init_page, pre_page, post_page
init_page Run before Variable substitution
pre_page Run after Variable substitution, before interpolation
post_page Run before Image substitution
Example -- you want your users to be able to edit pages and just put
in <A href=3D"someotherpage.html">. You can use post_page to handle
this. To do it, you want an entry in catalog.cfg:
Pragma post_page=3Drelative_urls
(Can also be in the page).
### Take hrefs like <A HREF=3D"about.url" and make relative to current
Sub <<EOR
sub relative_urls {
my $page =3D shift;
my @dirs =3D split "/", $Tag->var('MV_PAGE', 1);
pop @dirs;
my $basedir =3D join "/", @dirs;
$basedir ||=3D '';
$basedir .=3D '/' if $basedir;
my $sub =3D sub {
my ($entire, $pre, $url) =3D @_;
return $entire if $url =3D~ /^\w+:/;
my($page, $form) =3D split /\?/, $url, 2;
my $u =3D $Tag->area( { href =3D> "$basedir$page", form =3D> $form } );
return qq{$pre"$u"};
};
$$page =3D~ s{
(
(
<a \s+ (?:[^>]+?\s+)?
href \s*=3D\s*
)
(["']) ([^\s"'>]+) \3
)}
{
$sub->($1,$2,$4)
}gsiex;
return;
}
EOR
You can do multiple ones if you set it in catalog.cfg, by
making the value post_page=3Droutine1,routine2. (Currently, no
commas are accepted in [pragma name value], but that should
change.)
* Allow PUT operations. Add
[value-extended test=3Disput] Check for a PUT
[value-extended put_contents=3D1] Return PUT string
[value-extended put_ref=3D1] Return ref to PUT string (scalar)
Some more DAV-type features can be done, I think, but they are not yet
scoped.
Revision Changes Path
2.68 +32 -3 interchange/lib/Vend/Config.pm
rev 2.68, prev_rev 2.67
Index: Config.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.67
retrieving revision 2.68
diff -u -r2.67 -r2.68
--- Config.pm 15 Aug 2002 22:01:23 -0000 2.67
+++ Config.pm 1 Sep 2002 13:13:43 -0000 2.68
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.67 2002/08/15 22:01:23 mheins Exp $
+# $Id: Config.pm,v 2.68 2002/09/01 13:13:43 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -44,7 +44,7 @@
use Vend::Parse;
use Vend::Util;
=20
-$VERSION =3D substr(q$Revision: 2.67 $, 10);
+$VERSION =3D substr(q$Revision: 2.68 $, 10);
=20
my %CDname;
=20
@@ -248,6 +248,7 @@
['TcpMap', 'hash', ''],
['Environment', 'array', ''],
['TcpHost', undef, 'localhost 127.0.0.1'],
+ ['AcceptRedirect', 'yesno', 'No'],
['SendMailProgram', 'executable', [
$Global::SendMailLocation,
'/usr/sbin/sendmail',
@@ -413,7 +414,7 @@
['MaxQuantityField', undef, ''],
['MinQuantityField', undef, ''],
['LogFile', undef, 'etc/log'],
- ['Pragma', 'boolean', ''],
+ ['Pragma', 'boolean_value', ''],
['DynamicData', 'boolean', ''],
['NoImport', 'boolean', ''],
['NoImportExternal', 'yesno', 'no'],
@@ -1827,6 +1828,34 @@
=20
for (@setting) {
$c->{$_} =3D $val;
+ }
+ return $c;
+}
+
+# Sets a boolean array, but configurable value with tag=3Dvalue
+sub parse_boolean_value {
+ my($item,$settings) =3D @_;
+ my(@setting) =3D split /[\s,]+/, $settings;
+ my $c;
+
+ if(defined $C) {
+ $c =3D $C->{$item} || {};
+ }
+ else {
+ no strict 'refs';
+ $c =3D ${"Global::$item"} || {};
+ }
+
+ for (@setting) {
+ my ($k,$v);
+ if(/=3D/) {
+ ($k,$v) =3D split /=3D/, $_, 2;
+ }
+ else {
+ $k =3D $_;
+ $v =3D 1;
+ }
+ $c->{$k} =3D $v;
}
return $c;
}
2.108 +29 -2 interchange/lib/Vend/Interpolate.pm
rev 2.108, prev_rev 2.107
Index: Interpolate.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.107
retrieving revision 2.108
diff -u -r2.107 -r2.108
--- Interpolate.pm 26 Aug 2002 00:58:26 -0000 2.107
+++ Interpolate.pm 1 Sep 2002 13:13:43 -0000 2.108
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#=20
-# $Id: Interpolate.pm,v 2.107 2002/08/26 00:58:26 mheins Exp $
+# $Id: Interpolate.pm,v 2.108 2002/09/01 13:13:43 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -27,7 +27,7 @@
require Exporter;
@ISA =3D qw(Exporter);
=20
-$VERSION =3D substr(q$Revision: 2.107 $, 10);
+$VERSION =3D substr(q$Revision: 2.108 $, 10);
=20
@EXPORT =3D qw (
=20
@@ -452,6 +452,13 @@
sub substitute_image {
my ($text) =3D @_;
=20
+ ## If post_page routine processor returns true, return. Otherwise,
+ ## continue image rewrite
+ if($::Pragma->{post_page}) {
+ ::run_macro($::Pragma->{post_page}, $text)
+ and return;
+ }
+
unless ( $::Pragma->{no_image_rewrite} ) {
my $dir =3D $CGI::secure ?
($Vend::Cfg->{ImageDirSecure} || $Vend::Cfg->{ImageDir}) :
@@ -576,6 +583,10 @@
1 while $$html =3D~ s/\[pragma\s+(\w+)(?:\s+(\w+))?\]/
$::Pragma->{$1} =3D (length($2) ? $2 : 1), ''/ige;
=20
+ if($::Pragma->{init_page}) {
+ ::run_macro($::Pragma->{init_page}, $html);
+ }
+
# Substitute in Variable values
$$html =3D~ s/$Gvar/$Global::Variable->{$1}/g;
if($::Pragma->{dynamic_variables}) {
@@ -591,6 +602,10 @@
$$html =3D~ s/$Cvar/$::Variable->{$1}/g;
}
=20
+ if($::Pragma->{pre_page}) {
+ ::run_macro($::Pragma->{pre_page}, $html);
+ }
+
# Strip out [comment] [/comment] blocks
1 while $$html =3D~ s%$QR{comment}%%go;
=20
@@ -2632,6 +2647,9 @@
my $no =3D $opt->{'no'} || '';
=20
if($opt->{test}) {
+ $opt->{test} =3D~ /(?:is)?put/i
+ and
+ return defined $CGI::put_ref ? $yes : $no;
$opt->{test} =3D~ /(?:is)?file/i
and
return defined $CGI::file{$var} ? $yes : $no;
@@ -2643,6 +2661,11 @@
return '';
}
=20
+ if($opt->{put_contents}) {
+ return undef if ! defined $CGI::put_ref;
+ return $$CGI::put_ref;
+ }
+
my $val =3D $CGI::values{$var} || $::Values->{$var} || return undef;
$val =3D~ s/</</g unless $opt->{enable_html};
$val =3D~ s/\[/[/g unless $opt->{enable_itl};
@@ -2650,6 +2673,10 @@
if($opt->{file_contents}) {
return '' if ! defined $CGI::file{$var};
return $CGI::file{$var};
+ }
+
+ if($opt->{put_ref}) {
+ return $CGI::put_ref;
}
=20
if($opt->{outfile}) {
2.12 +45 -25 interchange/lib/Vend/Server.pm
rev 2.12, prev_rev 2.11
Index: Server.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.11
retrieving revision 2.12
diff -u -r2.11 -r2.12
--- Server.pm 14 Aug 2002 15:32:04 -0000 2.11
+++ Server.pm 1 Sep 2002 13:13:43 -0000 2.12
@@ -1,6 +1,6 @@
# Vend::Server - Listen for Interchange CGI requests as a background server
#
-# $Id: Server.pm,v 2.11 2002/08/14 15:32:04 mheins Exp $
+# $Id: Server.pm,v 2.12 2002/09/01 13:13:43 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -25,7 +25,7 @@
package Vend::Server;
=20
use vars qw($VERSION);
-$VERSION =3D substr(q$Revision: 2.11 $, 10);
+$VERSION =3D substr(q$Revision: 2.12 $, 10);
=20
use POSIX qw(setsid strftime);
use Vend::Util;
@@ -65,29 +65,36 @@
bless $http, $class;
}
=20
-my @Map =3D
- (
- 'authorization' =3D> 'AUTHORIZATION',
- 'content_length' =3D> 'CONTENT_LENGTH',
- 'content_type' =3D> 'CONTENT_TYPE',
- 'content_encoding' =3D> 'HTTP_CONTENT_ENCODING',
- 'cookie' =3D> 'HTTP_COOKIE',
- 'http_host' =3D> 'HTTP_HOST',
- 'path_info' =3D> 'PATH_INFO',
- 'pragma' =3D> 'HTTP_PRAGMA',
- 'query_string' =3D> 'QUERY_STRING',
- 'referer' =3D> 'HTTP_REFERER',
- 'remote_addr' =3D> 'REMOTE_ADDR',
- 'remote_host' =3D> 'REMOTE_HOST',
- 'remote_user' =3D> 'REMOTE_USER',
- 'request_method', =3D> 'REQUEST_METHOD',
- 'script_name' =3D> 'SCRIPT_NAME',
- 'secure' =3D> 'HTTPS',
- 'server_name' =3D> 'SERVER_NAME',
- 'server_host' =3D> 'HTTP_HOST',
- 'server_port' =3D> 'SERVER_PORT',
- 'useragent' =3D> 'HTTP_USER_AGENT',
-);
+my @Map =3D qw/
+ authorization AUTHORIZATION
+ content_length CONTENT_LENGTH
+ content_type CONTENT_TYPE
+ content_encoding HTTP_CONTENT_ENCODING
+ cookie HTTP_COOKIE
+ http_host HTTP_HOST
+ path_info PATH_INFO
+ pragma HTTP_PRAGMA
+ query_string QUERY_STRING
+ referer HTTP_REFERER
+ remote_addr REMOTE_ADDR
+ remote_host REMOTE_HOST
+ remote_user REMOTE_USER
+ request_method REQUEST_METHOD
+ script_name SCRIPT_NAME
+ secure HTTPS
+ server_name SERVER_NAME
+ server_host HTTP_HOST
+ server_port SERVER_PORT
+ useragent HTTP_USER_AGENT
+/;
+
+my @RedirMap =3D qw/
+ path_info REDIRECT_URL
+ query_string REDIRECT_QUERY_STRING
+ error_notes REDIRECT_ERROR_NOTES
+ redirect_status REDIRECT_STATUS
+ request_method REDIRECT_REQUEST_METHOD
+/;
=20
### This is to account for some bad Socket.pm implementations
### which don't set SOMAXCONN, I think SCO is the big one
@@ -197,6 +204,14 @@
if $Global::TolerateGet;
parse_post($h->{entity});
}
+ elsif ("\U$CGI::request_method" eq 'PUT') {
+#::logDebug("Put operation.");
+ parse_post(\$CGI::query_string);
+ $CGI::put_ref =3D $h->{entity};
+#::logDebug("Put contents: $$CGI::put_ref");
+ $$CGI::put_ref =3D~ s/^\s*--+\s+begin\s+content\s+--+\r?\n//i;
+ $$CGI::put_ref =3D~ s/^\r?\n--+\s+end\s+content\s+--+\s*$//i;
+ }
else {
parse_post(\$CGI::query_string);
}
@@ -2309,6 +2324,11 @@
my $next;
=20=09
my $pidh =3D open_pid($Global::PIDfile);
+
+ if($Global::AcceptRedirect) {
+ push @Map, @RedirMap
+ unless grep $_ eq 'REDIRECT_URL', @Map;
+ }
=20
if ($Global::mod_perl) {
undef $Global::Unix_Mode;
2.53 +3 -2 interchange/scripts/interchange.PL
rev 2.53, prev_rev 2.52
Index: interchange.PL
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/scripts/interchange.PL,v
retrieving revision 2.52
retrieving revision 2.53
diff -u -r2.52 -r2.53
--- interchange.PL 27 Aug 2002 16:52:06 -0000 2.52
+++ interchange.PL 1 Sep 2002 13:13:46 -0000 2.53
@@ -3,7 +3,7 @@
#
# Interchange version 4.9.3
#
-# $Id: interchange.PL,v 2.52 2002/08/27 16:52:06 mheins Exp $
+# $Id: interchange.PL,v 2.53 2002/09/01 13:13:46 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. and others.
# http://www.icdevgroup.org/
@@ -1997,6 +1997,7 @@
sub run_macro {
my $macro =3D shift
or return;
+ my $content_ref =3D shift;
=20
my @mac;
if(ref $macro eq 'ARRAY') {
@@ -2016,7 +2017,7 @@
logError("Unknown Autoload macro '%s'.", $macro);
next;
};
- $sub->();
+ $sub->($content_ref);
}
elsif($m =3D~ /^\w+-\w+$/) {
Vend::Interpolate::tag_profile($m);