Loading ...
Sorry, an error occurred while loading the content.

rfc 2817 type http tunnel/proxy

Expand Messages
  • jnf
    Hello,I am writing a perl (obviously) proxy/tunnel that complies with rfc 2817 as far as it uses the connect method to connect. I am however having some
    Message 1 of 5 , Jan 31, 2004
    • 0 Attachment
      Hello,

      I am writing a perl (obviously) proxy/tunnel that complies with rfc 2817
      as far as it uses the connect method to connect. I am however having some
      problems that appear to be on the web clients (read: browser) end, but i
      seem to have problems with all common browsers, so I think it must be me.
      I have attached the relevant source code because well, its fairley long
      and I cannot find an error that affect this for the life of me. Let me
      explain the problem, and then explain problems that I know exist in the
      script.

      problem:
      what happens is the client (say mozilla) connect to the proxy, it issues
      CONNECT host:port HTTP/1.1 and the rest of its header.
      my script replies with 200 ok, and a header
      at this point they negotiate a ssl connection, then the client sends me
      the request and i forward it to the correct host, when i get the reply, i
      forward it back to the client, sounds easy enough right?
      Ok well almost all of that works correctly, the client connects ok, issues
      the request ok, ssl is negotiated ok, request is sent to the remote
      server, remote server gets it and replies and i get the reply. The problem
      seems to be in giving the reply to the client. I've setup a packet sniffer
      and watched this all happening and Ive noticied the client sends a FIN
      just after it hands me the request after it establishes the ssl connection
      to the proxy (i.e. GET / HTTP/1.1), but this is only a half close and
      should still be able to read data from me, yet when i actually try to give
      it the reply i get a RST from the port, short packet dump below:

      TCP localhost.1722 -> localhost.8000 PSH seq: XXXX ack XXXX
      data: CONNECT www.google.com:443 HTTP/1.1\r\n ETC
      [ack cut out here]
      TCP localhost.8000 -> localhost.1722 PSHseq:XXXX ack XXXX
      data: 200 OK ETC
      [ack cut out here]
      SSL between proxy and client is negotiated here,
      client sends request (i.e. GET / ...)
      TCP localhost.1722 -> localhost.8000 FIN,ACK seq:XYZ ...
      proxy connects to remote server
      forwards request, gets reply
      proxy prints reply to client
      TCP localhost.8000 -> localhost.1722 PSH seq: XXXX etc
      TCP localhost.1722 -> localhost.8000 RST seq: XYZ+1

      ---

      Problems that I know exist in this script. i dont loop the reads at the end where i actually get/send data between
      the client/server, i havent gotten that far yet, this part wont work at
      all.

      At any rate, I cant figure out what the problem is, it seems to be in my
      implementation, rather than in the code itself, any help would be
      appreciated.

      jnf








      ----------

      use strict;
      use Cwd qw(abs_path);

      our $conport = 8000;
      our $dolog = 1;
      my $log_path = abs_path('.');
      our $logfile = "$log_path/proxy.log";
      our $ssl_dir = '/usr/local/ssl/ssl/private/';

      ----------

      #!/usr/bin/perl -w

      use strict;
      use POSIX qw(setsid WNOHANG);
      use IO::Socket;
      use IO::Socket::SSL qw(debug4);

      $| = 1;

      my ($CR, $LF, $CR_LF, $SP,$ME,$VERSION, $REPLY_STRING);
      $CR = "\x0d";
      $LF = "\x0a";
      $CR_LF = "\x0d\x0a";
      $SP = "\x20";
      $ME = 'ptunnel';
      $VERSION = 'v1.0';
      $REPLY_STRING .= $CR_LF .'Date: ' . tstamp() . $CR_LF . "Proxy-Connection: Keep-Alive" . $CR_LF . "Connection: Keep-Alive" . $CR_LF . "Keep-Alive: 600" . $CR_LF .
      "Proxy-Agent: $ME/$VERSION" . $CR_LF . $CR_LF; #. "Proxy-Agent: Apache/1.3.x (Unix)" . $CR_LF . $CR_LF;


      my ( $config,
      $port,
      $pid,
      $in,
      $name,
      $pserv,
      $client,
      $peer,
      $ssl,
      $method,
      $uri,
      $proto,
      $host,
      $rport,
      $len,
      $remote);

      our ( $conport,
      $ssl_dir,
      $dolog,
      $logfile);


      $config = "./conf.pl";

      $SIG{HUP} = \&doConf;
      $SIG{PIPE} = 'IGNORE';
      $SIG{CHLD} = \&reapKids;


      ################################
      # sig handlers / configuration #
      ################################

      sub doConf
      {

      lprint("reading $config for port...\n");
      unless(do $config)
      {
      lprint("couldn't parse $config: $@\n") if $@;
      lprint("failed!! port is defaulting to 8000\n");
      $port = 8000;
      goto NOCONF;
      }
      lprint("using port $conport\n");
      $port = $conport;

      NOCONF:
      }

      sub reapKids
      {
      1 until (-1 == waitpid(-1, WNOHANG));
      $SIG{CHLD} = \&reapKids;
      }

      ####################
      # general routines #
      ####################


      ####################################################
      # just a small function to print to stdout/logfile #
      # replaces print/die in all master print's #
      # lprint("message\n"); for print like semantics #
      # lprint("messages\n",1); for die like semantics #
      ####################################################

      sub lprint
      {
      my ($line, $fatal) = @_;

      print STDOUT localtime() . " $ME" ."[$$]: " . " $line";
      if(defined($fatal))
      {
      exit;
      }
      }

      ##################################################
      # this just setups up the listening server #
      # no real reason to make it exist in its own #
      # routine other than I am intending on making #
      # another version of this which has a master #
      # server which spawns X children that serve the #
      # requests ala apache. And this part wont change #
      ##################################################

      sub doProxy
      {

      lprint("setting up proxy server...\n");
      $pserv = IO::Socket::INET->new(Proto => 'tcp',
      Reuse => 1,
      Listen => SOMAXCONN,
      LocalPort => $port) || lprint("couldnt setup proxy server: $!\n",1);

      undef($port); # no longer needed


      }


      #################################################
      # just a short routine to call to decide if we #
      # are going to log or not, made a routine for #
      # the same reasons as doProxy() #
      #################################################

      sub doLog
      {
      if($dolog)
      {
      open(STDOUT, '>>', "/$logfile") || lprint("could not redirect stdout to $logfile: $!\n",1);
      }
      undef $dolog; # no longer needed

      }

      ################################################
      # generates http-style timestamps for our #
      # replies to the clients. #
      ################################################

      sub tstamp
      {
      my @days = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
      my @months = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug", "Sep","Oct","Nov","Dec");
      my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime();
      my ($tstamp,$tz, $longyr);

      $tz = 'GMT';
      $longyr = $year + 1900;
      $tstamp = sprintf("%3s, %02d %3s %04d %02d:%02d:%02d $tz",$days[$wday], $mday,$months[$mon], $longyr, $hr, $min, $sec);
      return $tstamp;
      }

      ##############################################
      # this is just our error trap function for #
      # start_SSL which will allow us to error out #
      # 'correctly' #
      ##############################################

      sub sslErr
      {
      my ($sock, $err) = @_;
      lprint("ssl accept failed: $err\n");
      $sock->syswrite("ssl accept failed: $err\n");
      close($sock);
      exit;
      }

      sub conErr
      {
      my ($rem,$sock) = @_;
      lprint("error in connecting to $rem, closing peers connection.\n");
      $sock->syswrite("XXX remote connect failed, closing connection\n");
      $sock->close(SSL_ctx_free => 1);
      exit;
      }

      ################
      # main routine #
      ################

      doConf();
      doProxy();

      my $str;
      $pid = fork();
      exit if $pid;
      lprint("fork failed: $!\n",1) unless defined $pid;
      setsid() || lprint("setsid(): $!\n",1);

      lprint("Starting log facilities, going into background.\n");
      doLog();

      while(1)
      {
      if(($client = $pserv->accept()))
      {
      lprint("incoming connection ...\n");
      $pid = fork();
      lprint("fork() failed: $!\n",1) unless defined $pid;
      if($pid)
      {
      lprint("fork successful ... going to wait for next client\n");
      last;
      }

      }

      }


      # we are now a child. (feel free to act like one).
      close($pserv); # child doesnt need
      $peer = $client->peerhost(); # i am $ME who are $YOU ?
      lprint("connection accepted from $peer\n");

      $len = $client->sysread($in, (128 * 1024 +1)); # max header len

      if($len > (128 *1024)) # we dont deal with a uri thats too large, just an overall header thats too large.
      {
      lprint("$peer gave us an invalid header of size $len, closing connection with code 413.\n");
      $client->syswrite("413 Request entity too large HTTP/1.1" . $REPLY_STRING);
      close($client);
      exit;
      }

      $in =~ s/^(?:\x0d?\x0a)+//; # ignore leading \r's and/or \n's

      if ($in !~ s/^(\S+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\x0a]*\x0a//)
      {

      lprint("$peer gave us an invalid header. closing connection with code 400\n");
      $client->syswrite("400 Bad Request HTTP/1.1" . $REPLY_STRING);
      close($client);
      exit;
      }
      # we should now have the method, uri, and proto handed to us, along with the rest of the header
      # we will now test to see if method eq CONNECT and if so we will strip the leading
      # http://|https://|etc off of it, and try a gethostbyname()
      # $1 = method $2 = uri $3 = proto

      $method = $1;
      $uri = $2;
      $proto = $3;

      lprint("in = $in\n");

      if(uc($method) =~ /CONNECT/)
      {
      lprint("$peer sent us $method $uri $proto\n");
      $client->syswrite("200 OK HTTP/1.1" . $REPLY_STRING);

      IO::Socket::SSL->start_SSL($client,
      SSL_server => 1,
      SSL_version => 'TLSv1.0',
      SSL_use_cert => 1, # shouldnt need to do this, but nice to do so.
      SSL_key_file => "$ssl_dir/privkey.pem",
      SSL_cert_file => "$ssl_dir/cacert.pem",
      SSL_verify_mode => 0x00) || sslErr($client, &IO::Socket::SSL::Errstr);



      ($host,$rport) = split(":",$uri);
      if(!defined($host))
      {
      $client->syswrite("400 Bad Request HTTP/1.1" . $REPLY_STRING);
      $client->close(SSL_ctx_free => 1);
      lprint("$peer gave us bad uri ($uri)\n",1);
      }
      lprint("attempting to validate/connect to $host:$rport\n");
      unless((($name, undef, undef, undef, undef) = gethostbyname($host)))
      {

      $client->syswrite("400 Bad Stuff d00de HTTP/1.1" . $REPLY_STRING);
      $client->close(SSL_ctx_free => 1);
      lprint("gethostbyname() failed for $host, disconnecting $peer\n",1);
      }
      lprint("host: $host name: $name\n");
      if($rport == 443)
      {
      if(!($remote = IO::Socket::SSL->new( PeerAddr => $name,
      PeerPort => $rport,
      Proto => 'tcp',
      SSL_version => 'TLSv1')))
      {

      $client->syswrite("408 STUFF AND THINGS HTTP/1.1" . $REPLY_STRING);
      $client->close(SSL_ctx_free => 1);
      lprint("unable to create outbound socket to $name:$rport: " . &IO::Socket::SSL::errstr . "\n");
      exit;
      }
      }
      else
      {
      $remote = IO::Socket::INET->new(PeerAddr => $name,
      PeerPort => $rport,
      Proto => 6,
      Type => SOCK_STREAM) || conErr($uri,$client);


      }
      lprint("connect to $name\n");
      my $buf;
      $len = $client->sysread($buf, (128 * 1024));
      lprint("len: $len\n");
      lprint("buf: $buf\n");
      $len = $remote->syswrite($buf);
      lprint("wrote len: $len\n");

      $len = $remote->sysread($buf, (1024 * 1024));
      lprint("read len: $len\n");
      $len = $client->syswrite($buf) || lprint("write to ssl failed: $!\n");
      lprint("remote len: $len\n");
      }


      lprint("child exiting ...\n");
      $client->close(SSL_ctx_free => 1);
      close($remote);
      exit;


      [Non-text portions of this message have been removed]
    Your message has been successfully submitted and would be delivered to recipients shortly.