Patch to make NaServer.pm work on FreeBSD

NaServer.pm

--- NaServer.old	2012-02-15 15:56:33.593579000 -0500
+++ NaServer.pm	2012-02-17 10:23:49.242005000 -0500
@@ -26,10 +26,8 @@
 use	Socket;
 use	LWP::UserAgent;
 use	XML::Parser;
-eval	"require	Net::SSLeay";
-eval	"require	IO::Select";
+use Data::Dumper;
 use	NaElement;
-use IO::Socket;
 # use	vars ('@ISA', '@EXPORT');
 # use	Exporter;
 
@@ -483,103 +481,14 @@
 	#my $xmlrequest = $req->sprintf();
 	my $xmlrequest = $req->toEncodedString();
 
-    print $xmlrequest;
-        # This is the filer url, in a form acceptable
-	# to the method line of an HTTP transaction.
-
-        my $url = $self->{url};
-
-	my($sockaddr);
-	my($name,$aliases,$proto,$port,$type,$len,$thisaddr);
-	my($thisport,$thatport);
-	my $lowport = 0;
-	my($thataddr);
-	my ($non_blocking);
-	
-	my $using_ssl = $self->use_https();
-	my $ssl;
-	
-	my $timeout = 60; #= $self->get_timeout();
-    print "*** $timeout\n";	
-	my $sock = undef;
-	my $need_server_cert_verification = $self->is_server_cert_verification_enabled();
-	
-	#
-	# Establish socket connection
-	#
-	$sockaddr = 'S n a4 x8';
-	if ($using_ssl) {
-	    ($name,$aliases,$proto)=getprotobyname('ssl');
-	     $proto = 0;
- 	} else {	
-	    ($name,$aliases,$proto)=getprotobyname('tcp');
-	}
-
-	($name,$aliases,$type,$len,$thataddr)=gethostbyname($server);
-	$thatport=pack($sockaddr, &AF_INET,$self->{port},$thataddr);
-	
-	$lowport = 1023 if ( $self->get_style() eq "HOSTS" );
-    
-	while($lowport >= 0) {
-		$sock = IO::Socket->new();
-		if (!socket($sock,&PF_INET,&SOCK_STREAM,$proto) ) {
-			return $self->fail_response(13001,
-				"in Zapi::invoke, cannot create socket");
-		}
-
-		#
-		# If we are being asked to use a reserved port (we
-		# are doing hosts.equiv authentication), then we search to
-		# find an available port number below 1024.
-		#
-		do{
-			# do not bind to a reserved port if it is used in previous invoke
-			if($lowport != 0 && $lowport == $self->{prev_resv_port}) {
-				$lowport--;
-			}
-			$thisport=pack($sockaddr, &AF_INET, $lowport);
-			$lowport--;
-		} while (!bind($sock,$thisport) && $lowport > 0);
-		if ($lowport == 0) {
-			close($sock);
-			return $self->fail_response(13001,
-				"in Zapi::invoke, unable to bind "
-				."to reserved port, you must be "
-				."executing as root");
-		}
-		$self->{prev_resv_port} = $lowport + 1;
-		
-		#handle connection time out.
-		if ($timeout > 0) {
-			$sock->timeout($timeout);
+    my $url = $self->{url};
 
-		}
-		
-		if (!$sock->connect($thatport)) {
-			close ($sock);
-			return $self->fail_response(13001,
-			"in Zapi::invoke, cannot connect to socket xxx");
-		} else {
-			last;
-		}
-	}
-	
-	select($sock); $| = 1;              # Turn on autoflushing
-	select(STDOUT); $| = 1;         # Select STDOUT as default output
-	
-        #
-	# Create an HTTP request.
-        #
-	my $request = HTTP::Request->new('POST',"$url");
-	
-	if ( $self->get_style() ne "HOSTS" ) {	
-		$request->authorization_basic($user,$password);
-	}
-	
+	my $request = HTTP::Request->new('POST',"http://$server$url");
+	$request->authorization_basic($user,$password);
 	
 	my $content = "";
 	my $vfiler_req = "";
-    
+
 	if($vfiler ne "") {
 		$vfiler_req = " vfiler= \"$vfiler\" ";
 	}
@@ -621,156 +530,8 @@
 	$request->content($content);
 	$request->content_length(length($content));
 
-	my $methline =  $request->method()." ".$request->uri()." HTTP/1.0\n";
-	my $headers  =  $request->headers_as_string();
-
-	if ($using_ssl) {
-		$ssl = Net::SSLeay::new($ctx) or return $self->fail_response(13001,
-			"in Zapi::invoke, failed to create SSL $!");
-		Net::SSLeay::set_fd($ssl, fileno($sock)); #Must use fileno
-
-		if ($need_server_cert_verification) {
-			Net::SSLeay::set_verify($ssl, 
-			&Net::SSLeay::VERIFY_PEER | &Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT, \&verify);
-		}
-
-		Net::SSLeay::connect($ssl) or return $self->fail_response(13001,
-		     "in Zapi::invoke failed to connect SSL $!");
-
-		if ($need_server_cert_verification) {
-			my $ret = $self->verify_server_certificate($ssl, $server);
-			if ($ret) {
-				Net::SSLeay::free($ssl);
-				close($sock);
-				return $ret;
-			}
-		}
-		
-		Net::SSLeay::ssl_write_all($ssl, $methline);
-		Net::SSLeay::ssl_write_all($ssl, $headers);
-		Net::SSLeay::ssl_write_all($ssl, "\n");
-		Net::SSLeay::ssl_write_all($ssl, $request->content());
-
-	} else {
-		print $sock $methline;
-		print $sock $headers;
-		print $sock  "\n";
-		print $sock $request->content();
-	}
-
-	my $xml = "";
-	my $response;
-
-	# Inside this loop we will read the response line and all headers
-	# found in the response.
-
-	my $n;
-	my $state = 0;	# 1 means we're in headers, 2 means we're in content
-	my ($key, $val);
-	my $line;
-
-
-	## Perl socket timeout has no effect during socket read.
-	## alarm is used (in eval block) to ensure that the control
-	## returns to the caller after the timeout period.
-
-	eval {
-		local $SIG{ALRM} = sub { die "Timed Out" };
-		# Setting the alarm with $timeout value
-		alarm $timeout;
-
-		while (1) {
-			if ($using_ssl) {
-		    		$line = Net::SSLeay::ssl_read_CRLF($ssl);
-			} else {	
-		    		$line = <$sock>;
-			}
-
-			if ( !defined($line) || $line eq "" ) {
-				last;
-			}
-			if ( $state == 0 ) {
-				if ($line =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
-					# HTTP/1.0 response or better
-					my($ver,$code,$msg) = ($1, $2, $3);
-					$msg =~ s/\015$//;
-					$response = HTTP::Response->new($code, $msg);
-					$response->protocol($ver);
-					$state = 1;
-					next;
-				} else {
-					if ($using_ssl) {
-						Net::SSLeay::free ($ssl);
-					}	
-					close($sock);
-					return $self->fail_response(13001,
-						"in Zapi::invoke, unable to parse "
-						."status response line - $line");
-				}
-			} elsif ( $state == 1 ) {
-				# ensure that we have read all headers.
-				# The headers will be terminated by two blank lines
-				if ( $line =~ /^\r*\n*$/ ) {
-					$state = 2;
-				} else {
-					if ($line =~ /^([a-zA-Z0-9_\-.]+)\s*:\s*(.*)/) {
-						$response->push_header($key, $val) if $key;
-						($key, $val) = ($1, $2);
-					} elsif ($line =~ /^\s+(.*)/ && $key) {
-						$val .= " $1";
-					} else {
-						$response->push_header(
-					    	"Client-Bad-Header-Line" => $line);
-					}
-				}
-			} elsif ( $state == 2 ) {
-				$xml .= $line;
-			} else {
-				if ($using_ssl) {
-					Net::SSLeay::free ($ssl);
-				}	
-				close($sock);
-				return $self->fail_response(13001,
-					"in Zapi::invoke, bad state value "
-					."while parsing response - $state\n");
-			}
-		}
-
-		# Reset the alarm to 0 (i.e. no alarm)
-		alarm 0;
-	}; # end of eval
-
-	# Check if the 'die' was executed in the previous eval
-	if($@ and $@ =~ /Timed Out/) {
-		if ($using_ssl) {
-			Net::SSLeay::free ($ssl);
-		}	
-		close($sock);
-		return $self->fail_response(13001,
-			"Timeout. Could not read API response.");
-	}
-
-
-	if ($using_ssl) {
-   	  Net::SSLeay::free ($ssl);  			# Tear down connection
-	}	
-	close($sock);
-
-	if (!defined($response)) {
-		 return $self->fail_response(13001,"No response received");
-	}
-	my $code = $response->code();
-	if ( $code == 401 ) {
-		return $self->fail_response(13002,"Authorization failed");
-	}
-	if ($self->is_debugging() > 0) {
-		if ($debug_style eq "NA_PRINT_DONT_PARSE") {
-			$self->set_raw_xml_output($xml);
-			print "\nOUTPUT:\n$xml\n";
-			return $self->fail_response(13001,"debugging bypassed xml parsing");
-		}
-	}
-	return $self->parse_xml($xml,$xmlrequest);
+    my $agent = LWP::UserAgent->new();
+	return $self->parse_xml($agent->simple_request($request)->content,$xmlrequest);
 }
 
 #============================================================#