Skip to content

fix(tied-hash + ssleay): each-after-delete + HTTPS via HTTP::Tiny #576

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
fglock merged 2 commits into from
Apr 27, 2026
+139 −33
Merged

fix(tied-hash + ssleay): each-after-delete + HTTPS via HTTP::Tiny #576

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
e9691af
fix(tied-hash): don't pre-fetch NEXTKEY between each() calls
fglock Apr 27, 2026
0c65f7f
feat(ssleay): wire get_https/post_https/do_https to HTTP::Tiny
fglock Apr 27, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/main/java/org/perlonjava/core/Configuration.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ public final class Configuration {
* Automatically populated by Gradle/Maven during build.
* DO NOT EDIT MANUALLY - this value is replaced at build time.
*/
public static final String gitCommitId = "90d0bb9f9";
public static final String gitCommitId = "1c27ead97";

/**
* Git commit date of the build (ISO format: YYYY-MM-DD).
Expand All @@ -48,7 +48,7 @@ public final class Configuration {
* Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at"
* DO NOT EDIT MANUALLY - this value is replaced at build time.
*/
public static final String buildTimestamp = "Apr 27 2026 16:38:19";
public static final String buildTimestamp = "Apr 27 2026 20:14:07";

// Prevent instantiation
private Configuration() {
Expand Down
58 changes: 30 additions & 28 deletions src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1292,47 +1292,50 @@ public void remove() {
* Uses Perl tie methods FIRSTKEY and NEXTKEY for iteration.
*/
private class RuntimeTiedHashIterator implements Iterator<RuntimeScalar> {
private RuntimeScalar currentKey;
private RuntimeScalar nextKey;
private boolean returnKey;
private boolean initialized;
private RuntimeScalar currentKey; // last key returned by FIRSTKEY/NEXTKEY (passed to next NEXTKEY)
private RuntimeScalar pendingKey; // key fetched by hasNext() but not yet consumed by next()
private boolean returnKey; // true: next() returns a key; false: next() returns the value
private boolean started; // whether FIRSTKEY has been called

/**
* Constructs a RuntimeTiedHashIterator for iterating over tied hash elements.
*/
public RuntimeTiedHashIterator() {
this.returnKey = true;
this.initialized = false;
this.started = false;
this.currentKey = null;
this.nextKey = null;
}

/**
* Initializes the iterator by calling FIRSTKEY if not already initialized.
*/
private void initialize() {
if (!initialized) {
nextKey = TieHash.tiedFirstKey(RuntimeHash.this);
initialized = true;
}
this.pendingKey = null;
}

/**
* Checks if there are more elements to iterate over.
* <p>
* Lazily calls FIRSTKEY (first time) or NEXTKEY (subsequent times) to fetch
* the upcoming key. The fetch happens here — not eagerly at the end of the
* previous next() — so that mutations to the tied hash between each() calls
* (e.g. {@code delete $h{$k}} during {@code while (each %h)}) are observed
* by the next NEXTKEY call, matching real Perl's semantics.
*
* @return True if there are more elements, false otherwise.
*/
@Override
public boolean hasNext() {
initialize();

// If we're about to return a value and have a current key, we have a next element
if (currentKey != null && !returnKey) {
// Mid-pair: a key was returned, value is still pending
if (!returnKey) {
return true;
}

// If we're about to return a key, check if nextKey is defined (not undef)
return returnKey && nextKey != null && nextKey.getDefinedBoolean();
// Need a fresh key — fetch it lazily if we don't already have one cached
if (pendingKey == null) {
if (!started) {
pendingKey = TieHash.tiedFirstKey(RuntimeHash.this);
started = true;
} else {
pendingKey = TieHash.tiedNextKey(RuntimeHash.this, currentKey);
}
}

return pendingKey != null && pendingKey.getDefinedBoolean();
}

/**
Expand All @@ -1348,17 +1351,16 @@ public RuntimeScalar next() {

if (returnKey) {
// Return the key and prepare to return its value next
currentKey = nextKey;
currentKey = pendingKey;
pendingKey = null;
returnKey = false;
return new RuntimeScalar(currentKey);
} else {
// Return the value and prepare for the next key
// Return the value (FETCH happens lazily through the proxy).
// Do NOT pre-fetch the next key here — that would race with
// user-visible mutations between each() calls.
RuntimeScalar value = RuntimeHash.this.get(currentKey);

// Get the next key for the next iteration
nextKey = TieHash.tiedNextKey(RuntimeHash.this, currentKey);
returnKey = true;

return value;
}
}
Expand Down
110 changes: 107 additions & 3 deletions src/main/perl/lib/Net/SSLeay.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -355,6 +355,27 @@ our @EXPORT_OK = qw(
XN_FLAG_SPC_EQ
);

# High-level HTTP/HTTPS helpers and utility subs. In real Net::SSLeay these
# are autoloaded Perl subs that callers can import — e.g. Net::HTTPS::Any does
# `use Net::SSLeay qw(get_https post_https make_headers make_form)`. Add them
# to @EXPORT_OK so `use` with an explicit import list doesn't fail at compile
# time even though the underlying OpenSSL operations themselves aren't
# implemented (they die at call time via _not_implemented).
push @EXPORT_OK, qw(
do_https
get_http get_http4
get_https get_https3 get_https4
get_httpx get_httpx4
post_http post_http4
post_https post_https3 post_https4
post_httpx post_httpx4
sslcat tcpcat tcpxcat
make_form make_headers
dump_peer_certificate
set_cert_and_key set_server_cert_and_key
die_if_ssl_error die_now print_errs
);

our %EXPORT_TAGS = (
all => \@EXPORT_OK,
);
Expand Down Expand Up @@ -391,17 +412,17 @@ sub print_errs {
return $errs;
}

sub do_https { _not_implemented("do_https") }
sub do_https { _do_https_request(@_) }
sub get_http { _not_implemented("get_http") }
sub get_http4 { _not_implemented("get_http4") }
sub get_https { _not_implemented("get_https") }
sub get_https { _https_get_or_post('GET', @_) }
sub get_https3 { _not_implemented("get_https3") }
sub get_https4 { _not_implemented("get_https4") }
sub get_httpx { _not_implemented("get_httpx") }
sub get_httpx4 { _not_implemented("get_httpx4") }
sub post_http { _not_implemented("post_http") }
sub post_http4 { _not_implemented("post_http4") }
sub post_https { _not_implemented("post_https") }
sub post_https { _https_get_or_post('POST', @_) }
sub post_https3 { _not_implemented("post_https3") }
sub post_https4 { _not_implemented("post_https4") }
sub post_httpx { _not_implemented("post_httpx") }
Expand All @@ -414,6 +435,89 @@ sub dump_peer_certificate { _not_implemented("dump_peer_certificate") }
sub set_cert_and_key { _not_implemented("set_cert_and_key") }
sub set_server_cert_and_key { _not_implemented("set_server_cert_and_key") }

# ---- HTTPS request shim backed by HTTP::Tiny --------------------------------
#
# PerlOnJava ships no OpenSSL backend, but it does ship HTTP::Tiny, which talks
# HTTPS via the JVM's TLS stack. These shims map the Net::SSLeay HTTP helper
# API onto HTTP::Tiny so modules like Net::HTTPS::Any work out of the box.
#
# Net::SSLeay return convention (for get_https/post_https/do_https):
# ($page, $response, @headers)
# where:
# - $page is the response body
# - $response is the HTTP status line, e.g. "HTTP/1.1 200 OK"
# - @headers is a flat (name => value, ...) list

sub _https_get_or_post {
my ($method, $host, $port, $path, $headers_str, $content, $content_type) = @_;
my $body = $method eq 'POST' ? $content : undef;
return _do_https_request(
$host, $port, $path, $method, $headers_str, $body, $content_type,
);
}

sub _do_https_request {
my ($host, $port, $path, $method, $headers_str, $content, $content_type,
# cert/key/password are accepted for API parity but unused
undef, undef, undef) = @_;

require HTTP::Tiny;

$port ||= 443;
$method ||= 'GET';
$path = '/' . $path if defined $path && $path !~ m{^/};
$path = '/' unless defined $path;

my $url = "https://$host:$port$path";

# Parse headers string (as produced by make_headers) into a hashref.
my %hdrs;
if (defined $headers_str && length $headers_str) {
for my $line (split /\r?\n/, $headers_str) {
next unless $line =~ /^([^:\s]+)\s*:\s*(.*)$/;
my ($k, $v) = ($1, $2);
# HTTP::Tiny rejects Host (it sets it itself); skip and let it manage.
next if lc($k) eq 'host';
if (exists $hdrs{$k}) {
$hdrs{$k} = [ $hdrs{$k} ] unless ref $hdrs{$k};
push @{ $hdrs{$k} }, $v;
} else {
$hdrs{$k} = $v;
}
}
}

my %opts = (headers => \%hdrs);
if (defined $content && length $content) {
$opts{content} = $content;
$hdrs{'Content-Type'} ||= ($content_type || 'application/x-www-form-urlencoded');
}

my $resp = HTTP::Tiny->new->request($method, $url, \%opts);

# HTTP::Tiny synthesises status 599 when the request couldn't be made.
# Mirror that as a status line so callers' regexes still see something.
my $proto = $resp->{protocol} || 'HTTP/1.1';
my $status = $resp->{status} // 599;
my $reason = $resp->{reason} // ($status == 599 ? 'Internal Exception' : '');
my $status_line = "$proto $status" . (length $reason ? " $reason" : '');

my @hdr_pairs;
if (ref $resp->{headers} eq 'HASH') {
for my $k (sort keys %{ $resp->{headers} }) {
my $v = $resp->{headers}{$k};
if (ref $v eq 'ARRAY') {
push @hdr_pairs, ($k, $_) for @$v;
} else {
push @hdr_pairs, ($k, $v);
}
}
}

my $page = defined $resp->{content} ? $resp->{content} : '';
return ($page, $status_line, @hdr_pairs);
}

sub make_form {
my @pairs;
while (@_) {
Expand Down
Loading