lotobo/regex-tools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 6 Wiki Activity

feat: add multi-engine regex flavour support

Browse Source
This commit is contained in:
Albrecht Degering
2026-07-27 11:43:51 +02:00
parent 7079cde15f
commit 7f3a91ad37
340 changed files with 643286 additions and 483 deletions
Download Patch File Download Diff File Expand all files Collapse all files

207
engines/perl/LICENSE-Devel-StackTrace-Artistic-2.0.txt Normal file
View File

@@ -0,0 +1,207 @@
This software is Copyright (c) 2000 - 2017 by David Rolsky.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
The Artistic License 2.0
Copyright (c) 2000-2006, The Perl Foundation.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
This license establishes the terms under which a given free software
Package may be copied, modified, distributed, and/or redistributed.
The intent is that the Copyright Holder maintains some artistic
control over the development of that Package while still keeping the
Package available as open source and free software.
You are always permitted to make arrangements wholly outside of this
license directly with the Copyright Holder of a given Package. If the
terms of this license do not permit the full use that you propose to
make of the Package, you should contact the Copyright Holder and seek
a different licensing arrangement.
Definitions
"Copyright Holder" means the individual(s) or organization(s)
named in the copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other
material to the Package, in accordance with the Copyright Holder's
procedures.
"You" and "your" means any person who would like to copy,
distribute, or modify the Package.
"Package" means the collection of files distributed by the
Copyright Holder, and derivatives of that collection and/or of
those files. A given Package may consist of either the Standard
Version, or a Modified Version.
"Distribute" means providing a copy of the Package or making it
accessible to anyone else, or in the case of a company or
organization, to others outside of your company or organization.
"Distributor Fee" means any fee that you charge for Distributing
this Package or providing support for this Package to another
party. It does not mean licensing fees.
"Standard Version" refers to the Package if it has not been
modified, or has been modified only in ways explicitly requested
by the Copyright Holder.
"Modified Version" means the Package, if it has been changed, and
such changes were not explicitly requested by the Copyright
Holder.
"Original License" means this Artistic License as Distributed with
the Standard Version of the Package, in its current version or as
it may be modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and
configuration files for the Package.
"Compiled" form means the compiled bytecode, object code, binary,
or any other form resulting from mechanical transformation or
translation of the Source form.
Permission for Use and Modification Without Distribution
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder
of the Standard Version, under the Original License, so that the
Copyright Holder may include your modifications in the Standard
Version.
(b) ensure that installation of your Modified Version does not
prevent the user installing or running the Standard Version. In
addition, the Modified Version must bear a name that is different
from the name of the Standard Version.
(c) allow anyone who receives a copy of the Modified Version to
make the Source form of the Modified Version available to others
under
(i) the Original License or
(ii) a license that permits the licensee to freely copy,
modify and redistribute the Modified Version using the same
licensing terms that apply to the copy that the licensee
received, and requires that the Source form of the Modified
Version, and of any works derived from it, be made freely
available in that license fees are prohibited but Distributor
Fees are allowed.
Distribution of Compiled Forms of the Standard Version
or Modified Versions without the Source
(5) You may Distribute Compiled forms of the Standard Version without
the Source, provided that you include complete instructions on how to
get the Source of the Standard Version. Such instructions must be
valid at the time of your distribution. If these instructions, at any
time while you are carrying out such distribution, become invalid, you
must provide new instructions on demand or cease further distribution.
If you provide valid instructions or cease distribution within thirty
days after you become aware that the instructions are invalid, then
you do not forfeit any of your rights under this license.
(6) You may Distribute a Modified Version in Compiled form without
the Source, provided that you comply with Section 4 with respect to
the Source of the Modified Version.
Aggregating or Linking the Package
(7) You may aggregate the Package (either the Standard Version or
Modified Version) with other packages and Distribute the resulting
aggregation provided that you do not charge a licensing fee for the
Package. Distributor Fees are permitted, and licensing fees for other
components in the aggregation are permitted. The terms of this license
apply to the use and Distribution of the Standard or Modified Versions
as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with
other works, to embed the Package in a larger work of your own, or to
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
General Provisions
(10) Any use, modification, and distribution of the Standard or
Modified Versions is governed by this Artistic License. By using,
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
(14) Disclaimer of Warranty:
THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

101
engines/perl/LICENSE-Emscripten.txt Normal file
View File

@@ -0,0 +1,101 @@
Emscripten is available under 2 licenses, the MIT license and the
University of Illinois/NCSA Open Source License.
Both are permissive open source licenses, with little if any
practical difference between them.
The reason for offering both is that (1) the MIT license is
well-known, while (2) the University of Illinois/NCSA Open Source
License allows Emscripten's code to be integrated upstream into
LLVM, which uses that license, should the opportunity arise.
The full text of both licenses follows.
==============================================================================
Copyright (c) 2010-2014 Emscripten authors, see AUTHORS file.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
==============================================================================
Copyright (c) 2010-2014 Emscripten authors, see AUTHORS file.
All rights reserved.
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), to deal with the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimers.
Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following disclaimers
in the documentation and/or other materials provided with the
distribution.
Neither the names of Mozilla,
nor the names of its contributors may be used to endorse
or promote products derived from this Software without specific prior
written permission.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR
ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE SOFTWARE.
==============================================================================
This program uses portions of Node.js source code located in src/library_path.js,
in accordance with the terms of the MIT license. Node's license follows:
"""
Copyright Joyent, Inc. and other Node contributors. All rights reserved.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to
deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
IN THE SOFTWARE.
"""
The musl libc project is bundled in this repo, and it has the MIT license, see
system/lib/libc/musl/COPYRIGHT
The third_party/ subdirectory contains code with other licenses. None of it is
used by default, but certain options use it (e.g., the optional closure compiler
flag will run closure compiler from third_party/).

68
engines/perl/NOTICE.txt Normal file
View File

@@ -0,0 +1,68 @@
Legacy WebPerl runtime notices
==============================
This directory contains the unmodified WebPerl v0.09-beta prebuilt runtime,
released in 2019 and explicitly treated by regex-tools as legacy beta software.
WebPerl
-------
Project: https://github.com/haukex/webperl
Release: v0.09-beta
Commit: 6f2173d29a2c2e3536e1de75ff5d291ae96ab348
Copyright (c) 2018 Hauke Daempfling, Leibniz Institute of Freshwater Ecology
and Inland Fisheries (IGB), Berlin, Germany.
WebPerl is distributed under the same terms as Perl 5: either the GNU General
Public License version 1 or later, or the Artistic License supplied with Perl 5.
The complete upstream texts are included as LICENSE-WebPerl-GPL.txt and
LICENSE-WebPerl-Artistic.txt.
Perl
----
The binary and data pack contain Perl v5.28.1 and its core library. Perl 5 is
distributed under the same GNU GPL / Artistic dual-license terms described
above. Exact upstream source is available from:
https://github.com/Perl/perl5/tree/v5.28.1
Emscripten
----------
The generated loader and WebAssembly runtime were built by upstream WebPerl
with Emscripten 1.38.28. Emscripten is dual-licensed under the MIT and
University of Illinois/NCSA licenses. The upstream 1.38.28 license text,
including its bundled-code notices, is included as LICENSE-Emscripten.txt.
Bundled CPAN additions
----------------------
The upstream prebuilt data pack also contains the modules selected by
WebPerl's pinned build:
- Cpanel::JSON::XS 4.09 — same terms as Perl 5;
- Devel::StackTrace 2.03 — Artistic License 2.0; its upstream distribution
license is included as LICENSE-Devel-StackTrace-Artistic-2.0.txt; and
- Future 0.39 — same terms as Perl 5.
The Devel::StackTrace license was reproduced byte-for-byte from
https://www.cpan.org/authors/id/D/DR/DROLSKY/Devel-StackTrace-2.03.tar.gz
(SHA-256 7618cd4ebe24e254c17085f4b418784ab503cb4cb3baf8f48a7be894e59ba848).
regex-tools uses Cpanel::JSON::XS only as the fixed bridge's bounded JSON
codec. It does not load Devel::StackTrace, Future, or WebPerl's JavaScript
interop module on the normal engine path. Those files remain present because
emperl.data is the unmodified, checksummed upstream prebuilt pack.
Security boundary
-----------------
The upstream generated emperl.js has one JavaScript eval(code) call in the
optional WebPerl JavaScript-interoperability import. regex-tools neither loads
nor calls that Perl module. User values cross the fixed bridge only as
exact-key, byte-bounded JSON in MEMFS; the sole Perl evaluator invocation is
the constant RegexTools::run_request(). The bounded metadata response is JSON,
while successful replacement UTF-8 bytes use a separate fixed MEMFS binary
file with exact worker-side length and encoding verification. Perl's
runtime-regex eval mode and regex code assertions are disabled.

66
engines/perl/README.md Normal file
View File

@@ -0,0 +1,66 @@
# Legacy Perl engine
This engine uses the unmodified prebuilt WebPerl `v0.09-beta` distribution,
which contains Perl `v5.28.1` compiled by Emscripten `1.38.28`. It is an
explicitly legacy, beta compatibility target. It is not current desktop Perl.
## Trust boundary
`regex_tools_bridge.pl` is fixed application source. The classic runtime worker
writes each exact-key, byte-bounded request as JSON to a fixed MEMFS path and
invokes only the constant Perl expression `RegexTools::run_request()`. The
metadata-only response uses a second bounded JSON file. Successful replacement
bytes use a third, fixed binary file; the worker checks its exact declared
length, output bound and canonical UTF-8 before supplying the decoded string to
the adapter. Pattern, subject, flags and replacement values are never
interpolated into Perl or JavaScript source.
The bridge:
- compiles a scalar pattern with `no re 'eval'`;
- independently rejects `(?{...})` and `(??{...})` outside escaped literals
and character classes;
- never imports the WebPerl JavaScript interoperability module;
- pre-tokenizes a deliberately bounded replacement grammar consisting of
literal text, `$$`, greedy `$n` and `${name}`;
- streams unmatched spans, literals and native capture values to the binary
output file in small UTF-8 chunks, stopping before a code point would cross
the output-byte bound;
- stops replacement at the match/capture-row result bound and preserves the
remaining subject as an unchanged tail;
- compares fixed named and numbered streaming fixtures with native Perl
`s///` output during the identity self-test;
- validates every request again inside Perl; and
- reports native Perl character offsets as Unicode code-point offsets.
Numbered capture participation and spans come from Perl's native `@-` and `@+`
arrays. The legacy runtime does not expose a stable name-to-number table, so
the adapter annotates those native capture rows with names from regex-tools'
syntax metadata. Numbered replacement values are streamed directly from their
native spans. Named replacement lookup itself uses Perl's native `%+`, and only
names present in the pre-tokenized template are read.
The prebuilt `emperl.js` contains one JavaScript `eval(code)` site in its
optional Perl-to-JavaScript interoperability import. The fixed bridge does not
load or call that facility. A Chromium CSP smoke succeeds with
`script-src 'self' 'wasm-unsafe-eval'` and without `'unsafe-eval'`.
The module worker remains responsive while the nested classic worker executes.
Terminating the supervised module worker terminates its worker descendants, so
catastrophic matching remains killable.
## Provenance
- WebPerl release: `v0.09-beta`
- Release commit: `6f2173d29a2c2e3536e1de75ff5d291ae96ab348`
- Prebuilt archive:
`https://github.com/haukex/webperl/releases/download/v0.09-beta/webperl_prebuilt_v0.09-beta.zip`
- Archive SHA-256:
`5f441249217e90ab378c666f473d4206ab4f44907f6bb0aa8d70834bc38c40dc`
- Perl runtime identity: `v5.28.1`
- Emscripten toolchain identified by the pinned upstream build configuration:
`1.38.28`
The deployed `emperl.js`, `emperl.wasm` and `emperl.data` files are copied
byte-for-byte from that archive. See `public/engines/perl/engine-metadata.json`,
`NOTICE.txt`, and the adjacent license files.

367
engines/perl/perl-runtime.worker.js Normal file
View File

@@ -0,0 +1,367 @@
"use strict";
/*
* Classic-worker wrapper for the pinned WebPerl 0.09-beta Emscripten runtime.
* User-controlled values cross into Perl only through a JSON file in MEMFS.
* Successful replacement bytes return through a separate fixed binary file;
* the bounded JSON response contains metadata only.
* The sole call through WebPerl's eval export is the fixed source string
* "RegexTools::run_request()"; no request data is interpolated into code.
*/
var BRIDGE_PROTOCOL_VERSION = 1;
var REQUEST_PATH = "/tmp/regex-tools-request.json";
var RESPONSE_PATH = "/tmp/regex-tools-response.json";
var OUTPUT_PATH = "/tmp/regex-tools-output.bin";
var HARNESS_PATH = "/tmp/regex-tools-bridge.pl";
var FIXED_INVOCATION = "RegexTools::run_request()";
var MAXIMUM_PATTERN_CHARACTERS = 64 * 1024;
var MAXIMUM_SUBJECT_BYTES = 16 * 1024 * 1024;
var MAXIMUM_REPLACEMENT_CHARACTERS = 64 * 1024;
var MAXIMUM_MATCHES = 10000;
var MAXIMUM_CAPTURE_ROWS = 100000;
var MAXIMUM_OUTPUT_BYTES = 64 * 1024 * 1024;
var MAXIMUM_REQUEST_JSON_BYTES =
6 *
(MAXIMUM_SUBJECT_BYTES +
MAXIMUM_PATTERN_CHARACTERS +
MAXIMUM_REPLACEMENT_CHARACTERS) +
16 * 1024;
var MAXIMUM_RESPONSE_JSON_BYTES = 8 * 1024 * 1024;
var utf8Encoder = new TextEncoder();
var runtimeRoot = new URL("./", self.location.href);
var runtimeResolve;
var runtimeReject;
var runtimeReady = new Promise(function (resolve, reject) {
runtimeResolve = resolve;
runtimeReject = reject;
});
var stderrTail = "";
function boundedRuntimeError(value) {
var message = value instanceof Error ? value.message : String(value);
if (stderrTail) {
message += " (" + stderrTail.slice(-512) + ")";
}
return message.slice(0, 1024);
}
function captureStderr(value) {
stderrTail = (stderrTail + String(value) + "\n").slice(-4096);
}
function isRecord(value) {
return typeof value === "object" && value !== null && !Array.isArray(value);
}
function owns(value, key) {
return Object.prototype.hasOwnProperty.call(value, key);
}
function isIntegerInRange(value, minimum, maximum) {
return Number.isSafeInteger(value) && value >= minimum && value <= maximum;
}
function hasExactKeys(value, expected) {
var actual = Object.keys(value).sort();
var wanted = expected.slice().sort();
if (actual.length !== wanted.length) return false;
for (var index = 0; index < actual.length; index += 1) {
if (actual[index] !== wanted[index]) return false;
}
return true;
}
function encodeRequest(request) {
if (
!isRecord(request) ||
request.abi !== 1 ||
typeof request.operation !== "string"
) {
throw new Error("The WebPerl bridge request is invalid.");
}
if (request.operation === "identity") {
if (!hasExactKeys(request, ["abi", "operation"])) {
throw new Error("The WebPerl identity request is invalid.");
}
} else {
var replacement = request.operation === "replace";
if (
(!replacement && request.operation !== "execute") ||
!hasExactKeys(
request,
[
"abi",
"operation",
"pattern",
"flags",
"options",
"subject",
"scanAll",
"maximumMatches",
"maximumCaptureRows",
].concat(replacement ? ["replacement", "maximumOutputBytes"] : []),
) ||
typeof request.pattern !== "string" ||
request.pattern.length > MAXIMUM_PATTERN_CHARACTERS ||
typeof request.flags !== "string" ||
request.flags.length > 10 ||
typeof request.subject !== "string" ||
typeof request.scanAll !== "boolean" ||
!isRecord(request.options) ||
Object.keys(request.options).length !== 0 ||
!isIntegerInRange(request.maximumMatches, 1, MAXIMUM_MATCHES) ||
!isIntegerInRange(request.maximumCaptureRows, 1, MAXIMUM_CAPTURE_ROWS)
) {
throw new Error("The WebPerl execution request is invalid.");
}
if (
utf8Encoder.encode(request.subject).byteLength > MAXIMUM_SUBJECT_BYTES
) {
throw new Error("The WebPerl subject exceeds its UTF-8 byte limit.");
}
if (
replacement &&
(typeof request.replacement !== "string" ||
request.replacement.length > MAXIMUM_REPLACEMENT_CHARACTERS ||
!isIntegerInRange(request.maximumOutputBytes, 1, MAXIMUM_OUTPUT_BYTES))
) {
throw new Error("The WebPerl replacement request is invalid.");
}
}
var encoded = utf8Encoder.encode(JSON.stringify(request));
if (encoded.byteLength > MAXIMUM_REQUEST_JSON_BYTES) {
throw new Error("The WebPerl request exceeds its JSON byte limit.");
}
return encoded;
}
function decodeUtf8Exact(encoded, label) {
var decoded;
try {
decoded = new TextDecoder("utf-8", { fatal: true }).decode(encoded);
} catch (_error) {
throw new Error(label + " is not valid UTF-8.");
}
var roundTrip = utf8Encoder.encode(decoded);
if (roundTrip.byteLength !== encoded.byteLength) {
throw new Error(label + " has an inconsistent UTF-8 length.");
}
for (var index = 0; index < encoded.byteLength; index += 1) {
if (roundTrip[index] !== encoded[index]) {
throw new Error(label + " is not canonical UTF-8.");
}
}
return decoded;
}
function readResponse() {
var encoded = FS.readFile(RESPONSE_PATH);
if (
Object.prototype.toString.call(encoded) !== "[object Uint8Array]" ||
encoded.byteLength === 0 ||
encoded.byteLength > MAXIMUM_RESPONSE_JSON_BYTES
) {
throw new Error("The fixed Perl bridge response exceeds its byte limit.");
}
var parsed;
try {
parsed = JSON.parse(decodeUtf8Exact(encoded, "The WebPerl response"));
} catch (error) {
if (error instanceof SyntaxError) {
throw new Error("The fixed Perl bridge returned malformed JSON.");
}
throw error;
}
if (!isRecord(parsed)) {
throw new Error("The fixed Perl bridge returned a non-object response.");
}
return parsed;
}
function injectReplacementOutput(response, maximumOutputBytes) {
if (
owns(response, "output") ||
!isIntegerInRange(response.outputBytes, 0, maximumOutputBytes) ||
typeof response.outputTruncated !== "boolean"
) {
throw new Error("The fixed Perl bridge returned invalid output metadata.");
}
var encoded = FS.readFile(OUTPUT_PATH);
if (
Object.prototype.toString.call(encoded) !== "[object Uint8Array]" ||
encoded.byteLength !== response.outputBytes ||
encoded.byteLength > maximumOutputBytes
) {
throw new Error(
"The fixed Perl bridge output file exceeds its bounded contract.",
);
}
response.output = decodeUtf8Exact(encoded, "The WebPerl output file");
}
function removeFixedFile(path) {
try {
FS.unlink(path);
} catch (_error) {
// The fixed file does not exist before its first use.
}
}
var Perl = {
trace: false,
glue: function () {
throw new Error("The WebPerl JavaScript bridge is disabled.");
},
unglue: function () {
throw new Error("The WebPerl JavaScript bridge is disabled.");
},
};
var Module = {
noInitialRun: true,
noExitRuntime: true,
arguments: ["--version"],
print: function () {},
printErr: captureStderr,
stdout: function () {},
stderr: function (character) {
if (character) {
stderrTail = (stderrTail + String.fromCharCode(character)).slice(-4096);
}
},
stdin: function () {
return null;
},
locateFile: function (file) {
return new URL(file, runtimeRoot).href;
},
preRun: [],
onRuntimeInitialized: function () {
runtimeResolve();
},
onAbort: function (reason) {
runtimeReject(
new Error("The legacy WebPerl runtime aborted: " + String(reason)),
);
},
};
importScripts(new URL("emperl.js", runtimeRoot).href);
var harnessPromise;
async function loadHarness() {
if (harnessPromise) return harnessPromise;
harnessPromise = (async function () {
await runtimeReady;
var response = await fetch(new URL("regex_tools_bridge.pl", runtimeRoot));
if (!response.ok) {
throw new Error(
"The fixed Perl bridge request failed with HTTP " +
response.status +
".",
);
}
var source = await response.text();
FS.writeFile(HARNESS_PATH, source, { encoding: "utf8" });
Module.callMain([HARNESS_PATH]);
return true;
})();
return harnessPromise;
}
async function invokeHarness(request) {
stderrTail = "";
await loadHarness();
if (stderrTail) {
throw new Error("The fixed Perl bridge failed to load: " + stderrTail);
}
removeFixedFile(REQUEST_PATH);
removeFixedFile(RESPONSE_PATH);
removeFixedFile(OUTPUT_PATH);
try {
FS.writeFile(REQUEST_PATH, encodeRequest(request));
var status = Module.ccall(
"webperl_eval_perl",
"string",
["string"],
[FIXED_INVOCATION],
);
if (status !== "ok") {
throw new Error("The fixed Perl bridge returned an invalid status.");
}
var parsed = readResponse();
if (request.operation === "replace" && parsed.ok === true) {
injectReplacementOutput(parsed, request.maximumOutputBytes);
} else if (
owns(parsed, "output") ||
owns(parsed, "outputBytes") ||
owns(parsed, "outputTruncated")
) {
throw new Error(
"The fixed Perl bridge returned output for a non-replacement result.",
);
}
return parsed;
} finally {
removeFixedFile(REQUEST_PATH);
removeFixedFile(RESPONSE_PATH);
removeFixedFile(OUTPUT_PATH);
}
}
async function handleMessage(message) {
if (
!message ||
message.protocolVersion !== BRIDGE_PROTOCOL_VERSION ||
!Number.isSafeInteger(message.requestId)
) {
throw new Error("The WebPerl bridge received an invalid message.");
}
if (message.kind === "load") {
return invokeHarness({ abi: 1, operation: "identity" });
}
if (message.kind === "run") {
if (
!message.request ||
typeof message.request !== "object" ||
Array.isArray(message.request)
) {
throw new Error("The WebPerl bridge received an invalid request.");
}
return invokeHarness(message.request);
}
throw new Error("The WebPerl bridge operation is unsupported.");
}
var operationQueue = Promise.resolve();
self.onmessage = function (event) {
var message = event.data;
var current = operationQueue.then(function () {
return handleMessage(message);
});
operationQueue = current.catch(function () {});
current.then(
function (payload) {
self.postMessage({
protocolVersion: BRIDGE_PROTOCOL_VERSION,
requestId: message && message.requestId,
ok: true,
payload: payload,
});
},
function (error) {
self.postMessage({
protocolVersion: BRIDGE_PROTOCOL_VERSION,
requestId: message && message.requestId,
ok: false,
error: {
name: error instanceof Error ? error.name : "Error",
message: boundedRuntimeError(error),
},
});
},
);
};

753
engines/perl/regex_tools_bridge.pl Normal file
View File

@@ -0,0 +1,753 @@
package RegexTools;
use strict;
use warnings;
use utf8;
use Cpanel::JSON::XS ();
no re 'eval';
our $BRIDGE_ABI_VERSION = 1;
our $REQUEST_PATH = '/tmp/regex-tools-request.json';
our $RESPONSE_PATH = '/tmp/regex-tools-response.json';
our $OUTPUT_PATH = '/tmp/regex-tools-output.bin';
my $JSON = Cpanel::JSON::XS->new->utf8->canonical;
my $TRUE = Cpanel::JSON::XS::true;
my $FALSE = Cpanel::JSON::XS::false;
my $MAXIMUM_PATTERN_CHARACTERS = 64 * 1024;
my $MAXIMUM_SUBJECT_BYTES = 16 * 1024 * 1024;
my $MAXIMUM_REPLACEMENT_CHARACTERS = 64 * 1024;
my $MAXIMUM_MATCHES = 10_000;
my $MAXIMUM_CAPTURE_ROWS = 100_000;
my $MAXIMUM_CAPTURE_GROUPS = 1_000;
my $MAXIMUM_OUTPUT_BYTES = 64 * 1024 * 1024;
my $MAXIMUM_ERROR_CHARACTERS = 1_024;
my $OUTPUT_CHUNK_CHARACTERS = 4_096;
my $MAXIMUM_REQUEST_BYTES = 6 * (
$MAXIMUM_SUBJECT_BYTES
+ $MAXIMUM_PATTERN_CHARACTERS
+ $MAXIMUM_REPLACEMENT_CHARACTERS
) + 16 * 1024;
my $MAXIMUM_RESPONSE_BYTES = 8 * 1024 * 1024;
sub _bounded_message {
my ($value) = @_;
$value = defined($value) ? "$value" : 'Unknown Perl bridge error';
$value =~ s/\s+at \Q@{[$0]}\E line \d+\.?\s*\z//;
return length($value) <= $MAXIMUM_ERROR_CHARACTERS
? $value
: substr($value, 0, $MAXIMUM_ERROR_CHARACTERS - 1) . "\x{2026}";
}
sub _utf8_bytes {
my ($value) = @_;
my $encoded = $value;
utf8::encode($encoded);
return $encoded;
}
sub _failure {
my ($phase, $code, $message) = @_;
return {
abi => $BRIDGE_ABI_VERSION,
ok => $FALSE,
phase => $phase,
code => $code,
message => _bounded_message($message),
};
}
sub _is_plain_hash {
my ($value) = @_;
return ref($value) eq 'HASH';
}
sub _has_exact_keys {
my ($value, @expected) = @_;
return 0 if !_is_plain_hash($value);
return join("\0", sort keys %$value)
eq join("\0", sort @expected);
}
sub _is_integer_in_range {
my ($value, $minimum, $maximum) = @_;
return defined($value)
&& !ref($value)
&& "$value" =~ /\A(?:0|[1-9][0-9]*)\z/
&& $value >= $minimum
&& $value <= $maximum;
}
sub _read_request {
open my $input, '<:raw', $REQUEST_PATH
or die "Unable to open the fixed bridge request file: $!";
local $/;
my $encoded = <$input>;
close $input or die "Unable to close the fixed bridge request file: $!";
die 'The fixed bridge request exceeds its byte limit.'
if !defined($encoded) || length($encoded) > $MAXIMUM_REQUEST_BYTES;
return $JSON->decode($encoded);
}
sub _write_response {
my ($response) = @_;
my $encoded = $JSON->encode($response);
die 'The fixed bridge response exceeds its byte limit.'
if length($encoded) > $MAXIMUM_RESPONSE_BYTES;
open my $output, '>:raw', $RESPONSE_PATH
or die "Unable to open the fixed bridge response file: $!";
print {$output} $encoded
or die "Unable to write the fixed bridge response file: $!";
close $output
or die "Unable to close the fixed bridge response file: $!";
}
sub _contains_code_assertion {
my ($pattern) = @_;
my $escaped = 0;
my $character_class = 0;
my $quoted = 0;
for (my $index = 0; $index < length($pattern); $index++) {
my $current = substr($pattern, $index, 1);
if ($quoted) {
if ($current eq '\\'
&& substr($pattern, $index + 1, 1) eq 'E') {
$quoted = 0;
$index++;
}
next;
}
if ($escaped) {
$escaped = 0;
next;
}
if ($current eq '\\') {
if (substr($pattern, $index + 1, 1) eq 'Q') {
$quoted = 1;
$index++;
}
else {
$escaped = 1;
}
next;
}
if ($current eq '[' && !$character_class) {
$character_class = 1;
next;
}
if ($current eq ']' && $character_class) {
$character_class = 0;
next;
}
next if $character_class;
return 1 if substr($pattern, $index, 3) eq '(?{';
return 1 if substr($pattern, $index, 4) eq '(??{';
}
return 0;
}
sub _validate_flags {
my ($flags) = @_;
return 'Flags must be a string.' if !defined($flags) || ref($flags);
my %seen;
for my $flag (split //, $flags) {
return 'The request contains an unsupported or duplicate Perl flag.'
if $flag !~ /\A[gimsxnadlu]\z/ || $seen{$flag}++;
}
my $character_rules = grep { $seen{$_} } qw(a d l u);
return 'Perl character-set flags a, d, l and u are mutually exclusive.'
if $character_rules > 1;
return;
}
sub _validate_request {
my ($request) = @_;
return _failure('bridge', 'invalid-request', 'The request must be a JSON object.')
if !_is_plain_hash($request);
return _failure('bridge', 'abi-mismatch', 'The bridge ABI version is unsupported.')
if !defined($request->{abi})
|| ref($request->{abi})
|| $request->{abi} != $BRIDGE_ABI_VERSION;
if (defined($request->{operation})
&& !ref($request->{operation})
&& $request->{operation} eq 'identity') {
return _failure(
'bridge',
'invalid-request',
'The identity request contains missing or unexpected fields.',
) if !_has_exact_keys($request, qw(abi operation));
return;
}
return _failure('bridge', 'invalid-operation', 'The bridge operation is unsupported.')
if !defined($request->{operation})
|| ref($request->{operation})
|| ($request->{operation} ne 'execute'
&& $request->{operation} ne 'replace');
my @request_fields = qw(
abi
flags
maximumCaptureRows
maximumMatches
operation
options
pattern
scanAll
subject
);
push @request_fields, qw(maximumOutputBytes replacement)
if $request->{operation} eq 'replace';
return _failure(
'bridge',
'invalid-request',
'The request contains missing or unexpected fields.',
) if !_has_exact_keys($request, @request_fields);
return _failure('bridge', 'invalid-request', 'Pattern and subject must be strings.')
if !defined($request->{pattern})
|| ref($request->{pattern})
|| !defined($request->{subject})
|| ref($request->{subject});
return _failure('bridge', 'pattern-limit', 'The pattern exceeds the bridge limit.')
if length($request->{pattern}) > $MAXIMUM_PATTERN_CHARACTERS;
return _failure('bridge', 'subject-limit', 'The subject exceeds the bridge limit.')
if length(_utf8_bytes($request->{subject})) > $MAXIMUM_SUBJECT_BYTES;
return _failure('bridge', 'unsupported-option', 'Perl does not accept engine options.')
if !_is_plain_hash($request->{options})
|| keys(%{$request->{options}});
my $flag_error = _validate_flags($request->{flags});
return _failure('bridge', 'unsupported-flag', $flag_error) if $flag_error;
return _failure(
'bridge',
'result-limit',
'The requested result bounds are outside the bridge contract.',
) if !_is_integer_in_range(
$request->{maximumMatches},
1,
$MAXIMUM_MATCHES,
) || !_is_integer_in_range(
$request->{maximumCaptureRows},
1,
$MAXIMUM_CAPTURE_ROWS,
);
return _failure(
'compile',
'code-assertion-disabled',
'Perl code assertions (?{...}) and (??{...}) are disabled.',
) if _contains_code_assertion($request->{pattern});
if ($request->{operation} eq 'execute') {
return _failure(
'bridge',
'invalid-request',
'Execution requests cannot contain replacement fields.',
) if exists($request->{replacement})
|| exists($request->{maximumOutputBytes});
return;
}
return _failure(
'bridge',
'invalid-request',
'Replacement requests require a string template and output bound.',
) if !defined($request->{replacement})
|| ref($request->{replacement})
|| !_is_integer_in_range(
$request->{maximumOutputBytes},
1,
$MAXIMUM_OUTPUT_BYTES,
);
return _failure(
'bridge',
'replacement-limit',
'The replacement template exceeds the bridge limit.',
) if length($request->{replacement}) > $MAXIMUM_REPLACEMENT_CHARACTERS;
return;
}
sub _compile_pattern {
my ($pattern, $flags) = @_;
my $modifiers = join '', grep { index($flags, $_) >= 0 }
qw(i m s x n a d l u);
my $wrapped = length($modifiers)
? "(?$modifiers:$pattern)"
: "(?:$pattern)";
my $compiled;
my $error;
{
local $SIG{__WARN__} = sub { };
local $@;
$compiled = eval { qr/$wrapped/ };
$error = $@;
}
return ($compiled, $error);
}
sub _capture_group_count {
my ($compiled) = @_;
my $probe = qr/(?:$compiled)|()/;
'' =~ $probe;
return $#- - 1;
}
sub _snapshot_match {
my ($group_count, $starts, $ends) = @_;
my @captures;
for my $group (1 .. $group_count) {
push @captures, defined($starts->[$group])
&& $starts->[$group] >= 0
? [0 + $starts->[$group], 0 + $ends->[$group]]
: undef;
}
return {
span => [0 + $starts->[0], 0 + $ends->[0]],
captures => \@captures,
};
}
sub _push_literal_token {
my ($tokens, $literal) = @_;
return if !length($$literal);
push @$tokens, ['literal', $$literal];
$$literal = '';
}
sub _tokenize_replacement {
my ($template, $group_count) = @_;
my @tokens;
my $literal = '';
my $cursor = 0;
while ($cursor < length($template)) {
my $current = substr($template, $cursor, 1);
if ($current ne '$') {
$literal .= $current;
$cursor++;
next;
}
my $next = substr($template, $cursor + 1, 1);
if ($next eq '$') {
_push_literal_token(\@tokens, \$literal);
push @tokens, ['literal', '$'];
$cursor += 2;
next;
}
if (substr($template, $cursor + 1) =~ /\A([0-9]+)/) {
my $digits = $1;
my $canonical = $digits;
$canonical =~ s/\A0+(?=[0-9])//;
my $number = length($canonical) <= length("$group_count")
&& $canonical <= $group_count
? 0 + $canonical
: undef;
_push_literal_token(\@tokens, \$literal);
push @tokens, ['capture', $number];
$cursor += 1 + length($digits);
next;
}
if (substr($template, $cursor + 1)
=~ /\A\{([A-Za-z_][A-Za-z0-9_]*)\}/) {
my $name = $1;
_push_literal_token(\@tokens, \$literal);
push @tokens, ['named', $name];
$cursor += 3 + length($name);
next;
}
$literal .= '$';
$cursor++;
}
_push_literal_token(\@tokens, \$literal);
return \@tokens;
}
sub _write_encoded {
my ($state, $encoded) = @_;
return if !length($encoded);
print {$state->{handle}} $encoded
or die "Unable to write the fixed bridge output file: $!";
$state->{bytes} += length($encoded);
}
sub _append_piece {
my ($state, $value) = @_;
return 0 if $state->{truncated};
return 1 if !length($value);
my $encoded = _utf8_bytes($value);
my $remaining = $state->{maximum} - $state->{bytes};
if (length($encoded) <= $remaining) {
_write_encoded($state, $encoded);
return 1;
}
my ($low, $high) = (0, length($value));
while ($low < $high) {
my $middle = int(($low + $high + 1) / 2);
my $prefix_bytes = length(_utf8_bytes(substr($value, 0, $middle)));
if ($prefix_bytes <= $remaining) {
$low = $middle;
}
else {
$high = $middle - 1;
}
}
_write_encoded($state, _utf8_bytes(substr($value, 0, $low)))
if $low > 0;
$state->{truncated} = $TRUE;
return 0;
}
sub _append_text {
my ($state, $value) = @_;
return 0 if $state->{truncated};
my $cursor = 0;
while ($cursor < length($value)) {
my $length = length($value) - $cursor;
$length = $OUTPUT_CHUNK_CHARACTERS
if $length > $OUTPUT_CHUNK_CHARACTERS;
return 0
if !_append_piece($state, substr($value, $cursor, $length));
$cursor += $length;
}
return 1;
}
sub _append_span {
my ($state, $subject, $start, $end) = @_;
return 0 if $state->{truncated};
my $cursor = $start;
while ($cursor < $end) {
my $length = $end - $cursor;
$length = $OUTPUT_CHUNK_CHARACTERS
if $length > $OUTPUT_CHUNK_CHARACTERS;
return 0
if !_append_piece($state, substr($subject, $cursor, $length));
$cursor += $length;
}
return 1;
}
sub _resolve_named_spans {
my ($tokens, $subject, $starts, $ends, $named_values) = @_;
my %resolved;
for my $token (@$tokens) {
my ($kind, $name) = @$token;
next if $kind ne 'named'
|| exists($resolved{$name})
|| !exists($named_values->{$name})
|| !defined($named_values->{$name});
my $captured = $named_values->{$name};
for my $group (1 .. $#$ends) {
next if !defined($starts->[$group])
|| $starts->[$group] < 0
|| $ends->[$group] - $starts->[$group] != length($captured)
|| index($subject, $captured, $starts->[$group])
!= $starts->[$group];
$resolved{$name} = [
0 + $starts->[$group],
0 + $ends->[$group],
];
last;
}
die "Unable to resolve native span for named capture $name."
if !exists($resolved{$name});
}
return \%resolved;
}
sub _append_replacement_tokens {
my ($state, $tokens, $subject, $starts, $ends, $named_spans) = @_;
for my $token (@$tokens) {
return 0 if $state->{truncated};
my ($kind, $value) = @$token;
if ($kind eq 'literal') {
_append_text($state, $value);
}
elsif ($kind eq 'capture') {
_append_span(
$state,
$subject,
$starts->[$value],
$ends->[$value],
) if defined($value)
&& defined($starts->[$value])
&& $starts->[$value] >= 0;
}
elsif ($kind eq 'named') {
_append_span(
$state,
$subject,
$named_spans->{$value}->[0],
$named_spans->{$value}->[1],
) if exists($named_spans->{$value});
}
else {
die 'The fixed replacement tokenizer produced an invalid token.';
}
}
return !$state->{truncated};
}
sub _open_output {
my ($maximum, $path) = @_;
open my $handle, '>:raw', $path
or die "Unable to open the fixed bridge output file: $!";
return {
handle => $handle,
bytes => 0,
maximum => 0 + $maximum,
truncated => $FALSE,
};
}
sub _close_output {
my ($state) = @_;
close $state->{handle}
or die "Unable to close the fixed bridge output file: $!";
delete $state->{handle};
}
sub _run_regex {
my ($request) = @_;
my ($compiled, $compile_error) = _compile_pattern(
$request->{pattern},
$request->{flags},
);
return _failure('compile', 'compile-error', $compile_error)
if !defined($compiled);
my $group_count = _capture_group_count($compiled);
return _failure(
'compile',
'capture-group-limit',
"The pattern declares $group_count capture groups; "
. "the bridge limit is $MAXIMUM_CAPTURE_GROUPS.",
) if $group_count > $MAXIMUM_CAPTURE_GROUPS;
my $rows_per_match = $group_count > 0 ? $group_count : 1;
my $allowed_matches = $request->{maximumMatches};
my $row_bound = int($request->{maximumCaptureRows} / $rows_per_match);
$allowed_matches = $row_bound if $row_bound < $allowed_matches;
my $subject = $request->{subject};
my $global = index($request->{flags}, 'g') >= 0;
my $replacement_tokens = $request->{operation} eq 'replace'
? _tokenize_replacement($request->{replacement}, $group_count)
: undef;
my @matches;
my $results_truncated = $FALSE;
my $replacement_state = defined($replacement_tokens)
? _open_output($request->{maximumOutputBytes}, $OUTPUT_PATH)
: undef;
$replacement_state->{cursor} = 0 if defined($replacement_state);
pos($subject) = 0;
while ($subject =~ /$compiled/g) {
my @starts = @-;
my @ends = @+;
if (@matches >= $allowed_matches) {
$results_truncated = $TRUE;
last;
}
push @matches, _snapshot_match(
$group_count,
\@starts,
\@ends,
);
if (defined($replacement_state)) {
_append_span(
$replacement_state,
$subject,
$replacement_state->{cursor},
$starts[0],
);
if (!$replacement_state->{truncated}) {
my $named_spans = _resolve_named_spans(
$replacement_tokens,
$subject,
\@starts,
\@ends,
\%+,
);
_append_replacement_tokens(
$replacement_state,
$replacement_tokens,
$subject,
\@starts,
\@ends,
$named_spans,
);
}
$replacement_state->{cursor} = $ends[0];
if ($replacement_state->{truncated}) {
$results_truncated = $TRUE;
last;
}
}
last if !$global;
}
my $response = {
abi => $BRIDGE_ABI_VERSION,
ok => $TRUE,
groupCount => 0 + $group_count,
groupNames => [],
matches => \@matches,
resultsTruncated => $results_truncated,
};
if (defined($replacement_state)) {
_append_span(
$replacement_state,
$subject,
$replacement_state->{cursor},
length($subject),
);
_close_output($replacement_state);
$response->{outputBytes} = 0 + $replacement_state->{bytes};
$response->{outputTruncated} = $replacement_state->{truncated};
}
return $response;
}
sub _render_self_test_replacement {
my ($compiled, $subject, $template, $maximum) = @_;
my $group_count = _capture_group_count($compiled);
my $tokens = _tokenize_replacement($template, $group_count);
return if $subject !~ /$compiled/;
my @starts = @-;
my @ends = @+;
my $named_spans = _resolve_named_spans(
$tokens,
$subject,
\@starts,
\@ends,
\%+,
);
my $encoded = '';
my $state = _open_output($maximum, \$encoded);
_append_span($state, $subject, 0, $starts[0]);
_append_replacement_tokens(
$state,
$tokens,
$subject,
\@starts,
\@ends,
$named_spans,
);
_append_span($state, $subject, $ends[0], length($subject));
_close_output($state);
my $decoded = $encoded;
return if !utf8::decode($decoded);
return ($decoded, 0 + $state->{bytes}, $state->{truncated});
}
sub _self_test {
return $FALSE if "$^V" ne 'v5.28.1';
my ($compiled, $error) = _compile_pattern(
'(?<word>\x{1F600}+)',
'u',
);
return $FALSE if $error || !defined($compiled);
my $subject = "x\x{1F600}\x{1F600}";
return $FALSE if $subject !~ /$compiled/;
return $FALSE if $-[0] != 1 || $+[0] != 3;
return $FALSE if $+{word} ne "\x{1F600}\x{1F600}";
my ($named, $named_bytes, $named_truncated) =
_render_self_test_replacement(
$compiled,
$subject,
'<${word}>',
1_024,
);
return $FALSE if !defined($named)
|| $named ne "x<\x{1F600}\x{1F600}>"
|| $named_bytes != 11
|| $named_truncated;
my $native_named = $subject;
$native_named =~ s/$compiled/<$+{word}>/;
return $FALSE if $named ne $native_named;
my $numbered_compiled = qr/(a)(b)/;
my ($numbered, $numbered_bytes, $numbered_truncated) =
_render_self_test_replacement(
$numbered_compiled,
'ab',
'$1-$$',
1_024,
);
my $native_numbered = 'ab';
$native_numbered =~ s/$numbered_compiled/$1-\$/;
return $FALSE if !defined($numbered)
|| $numbered ne $native_numbered
|| $numbered_bytes != 3
|| $numbered_truncated;
my ($greedy, $greedy_bytes, $greedy_truncated) =
_render_self_test_replacement(
qr/(a)(b)/,
'ab',
'$12/$1/$$/${missing}/$',
1_024,
);
return $FALSE if !defined($greedy)
|| $greedy ne '/a/$//$'
|| $greedy_bytes != 7
|| $greedy_truncated;
my ($bounded, $bounded_bytes, $bounded_truncated) =
_render_self_test_replacement(
$compiled,
$subject,
'<${word}>',
5,
);
return $FALSE if !defined($bounded)
|| $bounded ne 'x<'
|| $bounded_bytes != 2
|| !$bounded_truncated;
return $TRUE;
}
sub _identity {
return {
abi => $BRIDGE_ABI_VERSION,
ok => $TRUE,
identity => {
bridge => 'regex-tools-webperl-json',
bridgeVersion => $BRIDGE_ABI_VERSION,
engine => 'Perl regular expressions',
engineVersion => '5.28.1',
perlVersion => "$^V",
webPerlVersion => '0.09-beta',
offsetUnit => 'code-point',
replacementGrammar => 'literal + $$ + $n + ${name}',
replacementTransport => 'fixed MEMFS binary output file',
replacementParityOracle => 'fixed native s/// fixtures',
legacy => $TRUE,
beta => $TRUE,
selfTest => _self_test(),
},
};
}
sub run_request {
my $response;
my $ok = eval {
my $request = _read_request();
my $validation_failure = _validate_request($request);
$response = $validation_failure
|| ($request->{operation} eq 'identity'
? _identity()
: _run_regex($request));
1;
};
if (!$ok) {
$response = _failure(
'bridge',
'bridge-error',
$@ || 'Unknown fixed Perl bridge failure',
);
}
eval { _write_response($response); 1 } or do {
my $fallback = _failure(
'bridge',
'serialization-error',
$@ || 'The fixed Perl bridge could not serialize its response.',
);
_write_response($fallback);
};
return 'ok';
}
1;