# -*-Perl-*-
################################################################
###
### Http.pm
###
### Author: Internet Message Group
### Created: Apr 23, 1997
### Revised: Jul 4, 2004
###
my $PM_VERSION = "IM::Http.pm version 20031028(IM146)";
package IM::Http;
require 5.003;
require Exporter;
use IM::Util;
use IM::TcpTransaction;
use integer;
use strict;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(http_process http_spec);
use vars qw(*HTTPd);
########################
# HTTP access routines #
########################
# http_open(host, port, user, pass)
# host:
# port:
# user:
# pass:
# return value:
# 0: success
# -1: failure
#
sub http_open($$) {
my($host, $port) = @_;
my($resp);
my(@host_list);
if ($port ne '' && $port != 0 && $port != 80) {
@host_list = ("$host/$port");
} else {
@host_list = ($host);
}
im_notice("opening HTTP session\n");
&tcp_logging(0);
*HTTPd = &connect_server(\@host_list, 'http', 0);
unless ($HTTPd) {
im_warn("connection failed.\n");
return -1;
}
return 0;
}
sub http_close() {
im_notice("closing HTTP session.\n");
close(HTTPd);
return 0;
}
sub http_get($$$) {
my($path, $user, $pass) = @_;
local($_);
my(@Message);
im_notice("getting $path.\n");
&send_data(\*HTTPd, "GET $path HTTP/1.0", '');
if ($pass ne '') {
require IM::EncDec && import IM::EncDec;
my $cred = &b_encode_string("$user:$pass");
&send_data(\*HTTPd, "Authorization: Basic $cred",
'Authorization: ********');
}
&send_data(\*HTTPd, '', '');
@Message = ();
while () {
push (@Message, $_);
}
return \@Message;
}
# http_process(spec)
sub http_process($;$$) {
my($spec, $http_proxy, $no_proxy) = @_;
my($msg, $rcode, $auth);
my($user, $host, $port, $path);
my($target_host, $target_port);
$http_proxy = '' if ($no_proxy && $spec =~ /$no_proxy/);
if ($http_proxy) {
im_notice("using proxy: $http_proxy\n");
if ($http_proxy =~ /(.*):(.*)/) {
$target_host = $1;
$target_port = $2;
} else {
$target_host = $http_proxy;
$target_port = '';
}
}
my $pass = '';
my $retry = 3;
my $first = 1;
my $found = 0;
while (1) {
($user, $host, $port, $path) = &http_spec($spec);
if ($http_proxy ne '') {
if ($port ne '' && $port != 0 && $port != 80) {
$path = "http://$host:$port$path";
} else {
$path = "http://$host$path";
}
} else {
$target_host = $host;
$target_port = $port;
}
return (-1) if (http_open($target_host, $target_port) < 0);
$msg = http_get($path, $user, $pass);
http_close();
im_debug("HTTP response for $spec follows\n") if (&debug('http'));
my $new_spec = 0;
$rcode = 0;
$auth = '';
$pass = '';
while ($_ = shift(@$msg)) {
s/\r?\n//;
if (/^HTTP\/\S+\s+(\d+)/i) {
$rcode = $1;
}
if (/^Location:\s*(.*)/i) {
$spec = $1;
$new_spec = 1;
}
if (/^WWW-Authenticate:\s*(.*)/i) {
$auth = $1;
}
im_debug("$_\n") if (&debug('http'));
last if (/^$/);
}
next if ($rcode == 302 && $new_spec);
if ($rcode == 401 && $auth =~ /Basic/i && $retry--) {
require IM::GetPass && import IM::GetPass;
if ($first) {
$first = 0;
if (&usepwagent()) {
$pass = &loadpass('http', $auth, $path, $user);
if ($pass ne '') {
$found = 1;
next;
}
}
if (&usepwfiles()) {
$pass = &findpass('http', $auth, $path, $user);
if ($pass ne '') {
$found = 1;
next;
}
}
}
# last if ($found && $NoPwQueryOnFail);
$pass = &getpass_interact("Password: "); #xxx
next if ($pass ne '');
}
if ($rcode == 200 && $pass ne '' && &usepwagent()) {
&savepass('http', $auth, $path, $user, $pass);
}
last;
}
return (0, $msg);
}
# HTTP (--src=http://[user@]server[:port]/path)
sub http_spec($) {
my $spec = shift;
if ($spec eq '') {
$spec = httphome();
}
$spec =~ s/^http://i;
my $host = 'localhost';
my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin();
my $port = 0;
my $path;
if ($spec =~ m|^//([^/]+)(/.*)?|) {
my $s = $1;
$path = $2;
if ($s =~ /(.*)\@(.*)/) {
$user = $1;
$s = $2;
}
if ($s =~ /(.*):(.*)/) {
$host = $1;
$port = $2;
} else {
$host = $s;
}
} else {
$path = $spec;
}
return ($user, $host, $port, $path);
}
1;
__END__
=head1 NAME
IM::Http - HTTP handler
=head1 SYNOPSIS
use IM::Http;
(rc, data) = http_process(spec, http_proxy, no_proxy)
rc:
0: success
-1: failure
=head1 DESCRIPTION
The I module handles HTTP.
This modules is provided by IM (Internet Message).
=head1 EXAMPLES
my($rc, $data) = http_process($spec, httpproxy(), noproxy())
if ($rc < 0) {
exit 1;
}
foreach (@$data) {
print;
}
=head1 COPYRIGHT
IM (Internet Message) is copyrighted by IM developing team.
You can redistribute it and/or modify it under the modified BSD
license. See the copyright file for more details.
=cut
### Copyright (C) 1997, 1998, 1999 IM developing team
### All rights reserved.
###
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
###
### 1. Redistributions of source code must retain the above copyright
### notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
### notice, this list of conditions and the following disclaimer in the
### documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
### may be used to endorse or promote products derived from this software
### without specific prior written permission.
###
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.