From d1f62af44e3b5584437fe1f47f1670d17bb7d11d Mon Sep 17 00:00:00 2001 From: Sadeep Madurange Date: Sat, 18 Apr 2026 11:24:46 +0800 Subject: Make code more memory safe. --- vcx | 88 +++++++++++++++++++++++++++++++-------------------------------------- 1 file changed, 39 insertions(+), 49 deletions(-) diff --git a/vcx b/vcx index 481a797..8931ce0 100644 --- a/vcx +++ b/vcx @@ -355,27 +355,21 @@ sub run_commit { # Finalize patch bundle my $patch_bundle_hash = ""; if ($use_disk_patch || %patches) { - use IO::Compress::Gzip qw(gzip $GzipError); - my $tar_data; + my $bundle_tmp = File::Spec->catfile(TMP_DIR, "bundle.tar.gz"); + my $tar = Archive::Tar->new; + if ($use_disk_patch) { - open my $pt_in, '<:raw', $pt_path; - $tar_data = do { local $/; <$pt_in> }; - close $pt_in; + $tar->read($pt_path); unlink $pt_path; - } else { - my $tar = Archive::Tar->new; - $tar->add_data($_, $patches{$_}) for keys %patches; - $tar_data = $tar->write(); } - my $final_payload = $tar_data; - # 512 byte factor: Only gzip if bundle is large enough to be worth the overhead - if (length($tar_data) > 512) { - gzip \$tar_data => \$final_payload or die "Gzip failed: $GzipError"; - } + $tar->add_data($_, $patches{$_}) for keys %patches; - $patch_bundle_hash = sha1_hex($final_payload); - write_file(get_obj_path($patch_bundle_hash), $final_payload); + # Write directly to disk with Gzip to avoid loading huge tarballs into RAM + $tar->write($bundle_tmp, COMPRESS_GZIP); + + $patch_bundle_hash = hash_file_content($bundle_tmp); + rename($bundle_tmp, get_obj_path($patch_bundle_hash)); } # Revision file @@ -586,24 +580,28 @@ sub make_bin_patch { return length($patch) > 8 ? $patch : undef; } -sub apply_bin_patch { - my ($old_data, $patch) = @_; - return $old_data unless defined $patch && length($patch) > 8; - +sub apply_bin_patch_file { + my ($target_path, $patch_ref) = @_; + my $patch = $$patch_ref; + return unless length($patch) > 8; + my $new_size = unpack("Q", substr($patch, 0, 8)); - my $new_data = "\0" x $new_size; - - # Start with existing data as base - substr($new_data, 0, length($old_data)) = $old_data; + # Open target file for update and resize + open my $fh, '+<:raw', $target_path or die $!; + truncate($fh, $new_size); + my $pos = 8; while ($pos < length($patch)) { my ($offset, $len) = unpack("QL", substr($patch, $pos, 12)); $pos += 12; - substr($new_data, $offset, $len) = substr($patch, $pos, $len); + my $data = substr($patch, $pos, $len); $pos += $len; + + seek($fh, $offset, 0); + print $fh $data; } - return $new_data; + close $fh; } # Convert decimal to a padded 7-char hex string @@ -819,7 +817,7 @@ sub is_revision { sub get_file_version { my ($source, $path) = @_; - # Default to workspace + # Handle Workspace if (!defined $source) { return undef unless -e $path; if ((-s $path // 0) > MEM_LIMIT) { @@ -832,6 +830,7 @@ sub get_file_version { return \$data; } + # Resolve Revision my $rev_id = (lc($source) eq 'head') ? read_head() : $source; my $rev_file = File::Spec->catfile(REV_DIR, $rev_id); return undef unless -f $rev_file; @@ -858,7 +857,7 @@ sub get_file_version { my $obj_path = get_obj_path($node->{hash} // ''); return undef unless -f $obj_path; - # Extract and patch + # Extract Base Object to Temp File my ($tfh, $tpath) = tempfile(DIR => TMP_DIR, UNLINK => 1); binmode $tfh, IO_LAYER; @@ -868,43 +867,33 @@ sub get_file_version { close $ofh; close $tfh; + # Apply Patch via Streaming Bundle if ($patch_bundle_hash) { my $bundle_path = get_obj_path($patch_bundle_hash); - if (-f $bundle_path && -s $bundle_path > 0) { # Ensure bundle exists and isn't empty - open my $bfh, '<:raw', $bundle_path; - my $raw_bundle = do { local $/; <$bfh> }; - close $bfh; - - my $tar_data = (substr($raw_bundle, 0, 2) eq "\x1f\x8b") - ? Compress::Zlib::uncompress($raw_bundle) - : $raw_bundle; - - if ($tar_data) { - my $tar = Archive::Tar->new; - $tar->read($tar_data); - - my $patch_name = "$path.patch"; - # FIX: Check if the file exists in the tarball before trying to get it - if ($tar->contains_file($patch_name)) { - my $p_content = $tar->get_content($patch_name); - + if (-f $bundle_path && -s $bundle_path > 0) { + # Use iterator to find the patch without loading the whole tarball into RAM + my $next = Archive::Tar->iter($bundle_path, 1); + while (my $f = $next->()) { + if ($f->name eq "$path.patch") { + my $p_content = $f->get_content(); my ($pfh, $ppath) = tempfile(DIR => TMP_DIR, UNLINK => 1); binmode $pfh, ":raw"; print $pfh $p_content; close $pfh; + # Determine if text patch or binary block replacement if ($p_content =~ /^\d+(?:,\d+)?[adc]\d+/) { system("patch -s -f $tpath < $ppath >/dev/null 2>&1"); } else { - my $old_data = read_file($tpath); - my $new_data = apply_bin_patch($old_data, $p_content); - write_file($tpath, $new_data); + apply_bin_patch_file($tpath, \$p_content); } + last; } } } } + # Final Output decision based on result size if ((-s $tpath // 0) > MEM_LIMIT) { return $tpath; } else { @@ -913,3 +902,4 @@ sub get_file_version { } } + -- cgit v1.2.3