From de069519946b113fb7be770a2c3ed3e76373111a Mon Sep 17 00:00:00 2001
From: Tim Mullin <tim.mullin@webpros.com>
Date: Wed, 20 Nov 2024 22:08:17 +0000
Subject: [PATCH] Enable upload for large files

RT 82563: Enable the upload of files greater than 1GB in
size using the "put" operation. Stream the upload instead
of loading the entire file into memory and uploading all
at once.
---
 lib/HTTP/DAV.pm       | 73 ++++++++++++++++++++++++++++++++-----------
 lib/HTTP/DAV/Comms.pm | 29 ++++++++++-------
 2 files changed, 71 insertions(+), 31 deletions(-)

diff --git a/lib/HTTP/DAV.pm b/lib/HTTP/DAV.pm
index 1e654f6..488493f 100644
--- a/lib/HTTP/DAV.pm
+++ b/lib/HTTP/DAV.pm
@@ -1007,33 +1007,68 @@ sub _put {
     else {
         my $content = "";
         my $fail    = 0;
+        my $length  = 0;
+
+        # Content was passed in as a scalar ref
         if ($content_ptr) {
             $content = $$local;
+            $length = length($content);
         }
+
+        # Content is a local file presumably
         else {
-            if ( !CORE::open( F, $local ) ) {
-                $self->err( 'ERR_GENERIC',
-                    "Couldn't open local file $local: $!" );
-                $fail = 1;
+            $length = -s $local if -e $local;
+            my $fh;
+            if (! CORE::open($fh, "<", $local)) {
+                $self->err('ERR_GENERIC', "Couldn't open local file $local: $!");
+                return;
             }
-            else {
-                binmode F;
-                while (my $line = <F>) { $content .= $line; }
-                close F;
+
+            binmode($fh);
+
+            # Setting the content to a simple subroutine will
+            # let it upload the file one piece at a time.
+            # HTTP::Request provides this functionality.
+            $content = sub {
+                my $buffer;
+                my $num_bytes = read($fh, $buffer, 4096);
+                if ($num_bytes) {
+                    return $buffer;
+                }
+                else {
+                    close($fh);
+                }
+            };
+
+            # Since we set the content to be a subroutine,
+            # we need to set the content length here since the
+            # downstream code will no longer have access to the file name
+            $custom_headers = {} unless $custom_headers;
+            $custom_headers->{'Content-Length'} = $length;
+
+            # Simple check to see if the file is XML
+            # In HTTP::DAV::Comms::do_http_request(), the
+            # content is checked against a regular expression.
+            # But it cannot do this when the file is being streamed.
+            # So, we'll check the beginning of the file since that is
+            # where the "<?xml" tag would be present.
+            my $file_header;
+            my $bytes = read($fh, $file_header, 4096);
+            seek($fh, 0, 0);
+            if ($bytes && $file_header =~ /<\?xml/i) {
+                $custom_headers->{'Content-Type'} = 'text/xml';
             }
         }
+        my $resource = $self->new_resource( -uri => $target );
+        my $response = $resource->put($content, $custom_headers);
 
-        if ( !$fail ) {
-            my $resource = $self->new_resource( -uri => $target );
-            my $response = $resource->put($content,$custom_headers);
-            if ( $response->is_success ) {
-                $self->ok( "put $target (" . length($content) . " bytes)",
-                    $target );
-            }
-            else {
-                $self->err( 'ERR_RESP_FAIL',
-                    "put failed " . $response->message(), $target );
-            }
+        if ($response->is_success) {
+            $self->ok("put $target ($length bytes)", $target);
+         }
+        else {
+            $self->err('ERR_RESP_FAIL',
+                "put failed " . $response->message(), $target
+            );
         }
     }
 }
diff --git a/lib/HTTP/DAV/Comms.pm b/lib/HTTP/DAV/Comms.pm
index 5051fa6..a7ad948 100644
--- a/lib/HTTP/DAV/Comms.pm
+++ b/lib/HTTP/DAV/Comms.pm
@@ -160,21 +160,26 @@ sub do_http_request {
     #$headers->header("Host", $url_obj->host);
     $headers->header( "Host", $url_obj->host_port );
 
-    my $length = ($content) ? length($content) : 0;
-    $headers->header( "Content-Length", $length );
+    # If the content is a subroutine, don't try to use it to determine
+    # the length or type of the file.  We will have set the length earlier
+    if (ref($content) !~ m{CODE}) {
 
-    #print "HTTP HEADERS\n" . $self->get_headers->as_string . "\n\n";
+        my $length = ($content) ? length($content) : 0;
+        $headers->header("Content-Length", $length);
 
-    # It would be good if, at this stage, we could prefill the
-    # username and password values to prevent the client having
-    # to submit 2 requests, submit->401, submit->200
-    # This is the same kind of username, password remembering
-    # functionality that a browser performs.
-    #@userpass = $self->{_user_agent}->get_basic_credentials(undef, $url);
+        #print "HTTP HEADERS\n" . $self->get_headers->as_string . "\n\n";
 
-    # Add a Content-type of text/xml if the body has <?xml in it
-    if ( $content && $content =~ /<\?xml/i ) {
-        $headers->header( "Content-Type", "text/xml" );
+        # It would be good if, at this stage, we could prefill the
+        # username and password values to prevent the client having
+        # to submit 2 requests, submit->401, submit->200
+        # This is the same kind of username, password remembering
+        # functionality that a browser performs.
+        #@userpass = $self->{_user_agent}->get_basic_credentials(undef, $url);
+
+        # Add a Content-type of text/xml if the body has <?xml in it
+        if ($content && $content =~ /<\?xml/i) {
+            $headers->header("Content-Type" => "text/xml");
+        }
     }
 
     ####