Commit 9e423f6f authored by sikeda's avatar sikeda
Browse files

[dev] Introducing Sympa::Tools::Text::weburl() and Sympa::get_url() to construct web URLs.

Sympa::get_url() supports four modes: default, omit, remote and local.  See documentation.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@12721 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent b2ca6ce4
......@@ -48,6 +48,7 @@ use DateTime;
use Digest::MD5;
use English qw(-no_match_vars);
use Scalar::Util qw();
use URI;
use Conf;
use Sympa::Constants;
......@@ -1285,6 +1286,143 @@ sub get_listmasters_email {
=over
=item get_url ( $that, $action, [ nomenu =E<gt> 1 ], [ paths =E<gt> \@paths ],
[ authority =E<gt> $mode ],
[ options... ] )
Returns URL for web interface.
Parameters:
=over
=item $action
Name of action.
This is inserted into URL intact.
=item authority =E<gt> $mode
C<'default'> respects C<wwsympa_url> parameter.
C<'remote'> replaces scheme, host and port using CGI environment variables.
C<'local'> is similar but may additionally replace script path.
C<'omit'> omits scheme and authority, i.e. returns relative URI.
Note that C<'remote'> and C<'local'> modes work correctly only under
CGI environment.
=item nomenu =E<gt> 1
Adds C<nomenu> modifier.
=item paths =E<gt> \@paths
Additional path components.
Note that they are percent-encoded as necessity.
=item options...
See L<Sympa::Tools::Text/"weburl">.
=back
Returns:
A string.
Note:
If $mode is C<'local'>, result is that Sympa server recognizes locally.
In other cases, result is the URI that is used by end users to access to web
interface.
C<'local'> URI can be differ from others when, for example, the server is
placed behind reverse proxy.
=back
=cut
sub get_url {
my $that = shift;
my $action = shift;
my %options = @_;
my $robot_id =
(ref $that eq 'Sympa::List') ? $that->{'domain'}
: ($that and $that ne '*') ? $that
: '*';
my $option_authority = $options{authority} || 'default';
my $base;
if ($option_authority eq 'remote' or $option_authority eq 'local') {
my $uri = URI->new(Conf::get_robot_conf($robot_id, 'wwsympa_url'));
# Override scheme, host and port by actual ones.
if ($ENV{HTTPS} and $ENV{HTTPS} eq 'on') {
$uri->scheme('https');
}
my ($host_port, $port);
if ($option_authority eq 'remote') {
# Try authority remotely given.
# Note: Several proxies set "X-Forwarded-Host:" and/or
# "X-Forwarded-Server:" fields. Some of them (e.g. AWS load
# balancer) additionally set "X-Forwarded-Port:" field.
if ($host_port = $ENV{HTTP_X_FORWARDED_HOST}) {
$host_port = [split /\s*,\s*/, $host_port]->[0];
} elsif ($host_port = $ENV{HTTP_X_FORWARDED_SERVER}) {
$host_port = [split /\s*,\s*/, $host_port]->[0];
$port = $ENV{HTTP_X_FORWARDED_PORT};
}
} else { # 'local'
if (my $path = $ENV{SCRIPT_NAME}) {
$uri->path($path);
}
}
unless ($host_port) {
# Try authority locally given.
if ($host_port = $ENV{HTTP_HOST}) {
;
} else {
# HTTP/1.0 or earlier?
$host_port = $ENV{SERVER_NAME};
$port = $ENV{SERVER_PORT};
}
}
if ($host_port) {
if ($host_port !~ /[^:0-9a-f]/i and $host_port =~ /:.*:/) {
# IPv6 address not enclosed.
$host_port = "[$host_port]";
}
unless ($host_port =~ /:\d+\z/) {
$host_port .= ':'
. ($port ? $port : ($uri->scheme eq 'https') ? 443 : 80);
}
$uri->host_port($host_port);
}
$base = $uri->canonical->as_string;
} elsif ($option_authority eq 'omit') {
$base =
URI->new(Conf::get_robot_conf($robot_id, 'wwsympa_url'))->path;
} else { # 'default'
$base = Conf::get_robot_conf($robot_id, 'wwsympa_url');
}
$base .= '/nomenu' if $options{nomenu};
$base .= '/' . $action if defined $action and length $action;
if (ref $that eq 'Sympa::List') {
return Sympa::Tools::Text::weburl($base,
[$that->{'name'}, @{$options{paths} || []}], %options);
} else {
return Sympa::Tools::Text::weburl($base, $options{paths}, %options);
}
}
=over
=item is_listmaster ( $that, $who )
Is the user listmaster?
......
......@@ -247,22 +247,35 @@ sub mailtourl {
$utext = Sympa::Tools::Text::encode_uri($dtext, omit => '@');
$qsep = '?';
}
my $qstring = _url_query_string(
$options{query},
decode_html => $options{decode_html},
leadchar => $qsep,
sepchar => '&',
trim_values => 1,
);
return sprintf $format, $utext, $qstring;
}
sub _url_query_string {
my $query = shift;
my %options = @_;
my $qstring;
my $query = $options{query};
unless (ref $query eq 'HASH' and %$query) {
$qstring = '';
return '';
} else {
$qstring = $qsep . join(
'&',
my $decode_html = $options{decode_html};
my $trim_values = $options{trim_values};
return ($options{leadchar} || '?') . join(
($options{sepchar} || ';'),
map {
my ($dkey, $dval) = map {
(not defined $_) ? ''
: $options{decode_html}
? Sympa::Tools::Text::decode_html($_)
: $_;
(not defined $_) ? ''
: $decode_html ? Sympa::Tools::Text::decode_html($_)
: $_;
} ($_, $query->{$_});
unless (lc $dkey eq 'body') {
if ($trim_values and lc $dkey ne 'body') {
$dval =~ s/\A\s+//;
$dval =~ s/\s+\z//;
$dval =~ s/(?:\r\n|\r|\n)(?=[ \t])//g;
......@@ -275,8 +288,6 @@ sub mailtourl {
} sort keys %$query
);
}
return sprintf $format, $utext, $qstring;
}
# Old name: tools::qdecode_filename().
......@@ -353,6 +364,42 @@ sub valid_email {
return 1;
}
sub weburl {
my $base = shift;
my $paths = shift;
my %options = @_;
my @paths = map {
Sympa::Tools::Text::encode_uri(
(not defined $_) ? ''
: $options{decode_html} ? Sympa::Tools::Text::decode_html($_)
: $_
);
} @{$paths || []};
my $qstring = _url_query_string(
$options{query},
decode_html => $options{decode_html},
sepchar => '&',
);
my $fstring;
my $fragment = $options{fragment};
if (defined $fragment) {
$fstring = '#'
. Sympa::Tools::Text::encode_uri(
$options{decode_html}
? Sympa::Tools::Text::decode_html($fragment)
: $fragment
);
} else {
$fstring = '';
}
return sprintf '%s%s%s', join('/', grep { defined $_ } ($base, @paths)),
$qstring, $fstring;
}
1;
__END__
......@@ -587,6 +634,43 @@ L</decode_filesystem_safe>.
Basic check of an email address.
=item weburl ( $base, \@paths, [ decode_html =E<gt> 1 ],
[ fragment =E<gt> $fragment ], [ query =E<gt> \%query ] )
Constructs a C<http:> or C<https:> URL under given base URI.
Parameters:
=over
=item $base
Base URI.
=item \@paths
Additional path components.
=item decode_html =E<gt> 1
If set, arguments are assumed to include HTML entities.
Exception is $base:
It is assumed not to include entities.
=item fragment =E<gt> $fragment
Optional fragment.
=item query =E<gt> \%query
Optional query.
=back
Returns:
A URI.
=item wrap_text ( $text, [ $init_tab, [ $subsequent_tab, [ $cols ] ] ] )
I<Function>.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment