2 # {{{ BEGIN BPS TAGGED BLOCK
6 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
7 # <jesse@bestpractical.com>
9 # (Except where explicitly superseded by other copyright notices)
14 # This work is made available to you under the terms of Version 2 of
15 # the GNU General Public License. A copy of that license should have
16 # been provided with this software, but in any event can be snarfed
19 # This work is distributed in the hope that it will be useful, but
20 # WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 # General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29 # CONTRIBUTION SUBMISSION POLICY:
31 # (The following paragraph is not intended to limit the rights granted
32 # to you to modify and distribute this software under the terms of
33 # the GNU General Public License and is only of importance to you if
34 # you choose to contribute your changes and enhancements to the
35 # community by submitting them to Best Practical Solutions, LLC.)
37 # By intentionally submitting any modifications, corrections or
38 # derivatives to this work, or any other work intended for use with
39 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
40 # you are the copyright holder for those contributions and you grant
41 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
42 # royalty-free, perpetual, license to use, copy, create derivative
43 # works based on those contributions, and sublicense and distribute
44 # those contributions and any derivatives thereof.
46 # }}} END BPS TAGGED BLOCK
52 require ('@RT_BIN_PATH@/webmux.pl');
54 use lib( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
60 my $port = shift || '8080';
66 my $tcp = getprotobyname('tcp');
68 socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or die "socket: $!";
69 setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) )
70 or warn "setsockopt: $!";
71 bind( HTTPDaemon, sockaddr_in( $port, INADDR_ANY ) ) or die "bind: $!";
72 listen( HTTPDaemon, SOMAXCONN ) or die "listen: $!";
74 print("You can connect to your RT server at http://localhost:$port/\n");
78 for ( ; accept( Remote, HTTPDaemon ); close Remote ) {
83 my $remote_sockaddr = getpeername(STDIN);
84 my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr);
85 my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost";
86 my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1";
88 my $local_sockaddr = getsockname(STDIN);
89 my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
90 my $localname = gethostbyaddr( $localiaddr, AF_INET )
92 my $localaddr = inet_ntoa($localiaddr) || "127.0.0.1";
94 chomp( $_ = <STDIN> );
95 my ( $method, $request_uri, $proto, undef ) = split;
97 #$request_uri =~ s#\\#/#g;
98 $RT::Logger->info("<- $peername: $_");
99 my ( $file, undef, $query_string ) =
100 ( $request_uri =~ /([^?]*)(\?(.*))?/ ); # split at ?
101 #$file =~ s/%([\dA-Fa-f]{2})/chr(hex($1))/eg; # decode url-escaped entities
103 last if ( $method !~ /^(GET|POST|HEAD)$/ );
105 build_cgi_env( method => $method,
106 query_string => $query_string,
110 peername => $peername,
111 peeraddr => $peeraddr,
112 localname => $localname,
113 request_uri => $request_uri );
115 RT::ConnectToDatabase();
116 my $cgi = CGI->new();
118 print "HTTP/1.0 200 OK\n"; # probably OK by now
120 if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
121 && ($Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) )
123 $cgi->path_info( $cgi->path_info . "/index.html" );
126 eval { $Handler->handle_cgi_object($cgi); };
127 $RT::Logger->crit($@) if ($@);
129 if ( $RT::Handle->TransactionDepth ) {
130 $RT::Handle->ForceRollback;
131 $RT::Logger->crit( "Transaction not committed. Usually indicates a software fault. Data loss may have occurred");
143 my %args = ( query_string => '',
149 remote_name => undef,
154 foreach my $var qw(USER_AGENT CONTENT_LENGTH CONTENT_TYPE
155 COOKIE SERVER_PORT SERVER_PROTOCOL SERVER_NAME
156 PATH_INFO REQUEST_URI REQUEST_METHOD REMOTE_ADDR
157 REMOTE_HOST QUERY_STRING SERVER_SOFTWARE) {
162 if( /^([\w\-]+): (.+)/i) {
164 $tag =~ s/^COOKIES$/COOKIE/;
167 $tag = "HTTP_".$tag unless (grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE COOKIE));
169 $ENV{$tag} .= "; $val";
179 $ENV{SERVER_PROTOCOL} = $args{protocol};
180 $ENV{SERVER_PORT} = $args{port};
181 $ENV{SERVER_NAME} = $args{'localname'};
182 $ENV{SERVER_URL} = "http://".$args{'localname'}.":".$args{'port'}."/";
183 $ENV{PATH_INFO} = $args{'path'};
184 $ENV{REQUEST_URI} = $args{'request_uri'};
185 $ENV{REQUEST_METHOD} = $args{method};
186 $ENV{REMOTE_ADDR} = $args{'peeraddr'};
187 $ENV{REMOTE_HOST} = $args{'peername'};
188 $ENV{QUERY_STRING} = $args{'query_string'};
189 $ENV{SERVER_SOFTWARE} = "rt-standalone/$RT::VERSION";
191 CGI::initialize_globals();