This section is the place to post useful code ‐ anything from one-liners to full-blown frameworks and apps.
(Perl poetry and obfuscated code should be posted in those respective sections.)
A few months ago I decided to do a little fun exercise (with AI's help). The little programs all do the same thing. The first one is written in Perl. The second one is written in AutoIt language, followed by QBASIC, then C, then JScript, Lua, PHP, Python, Bash, Excel VBA, and Linux x86 / x86_64 assembly.
Perl:
#!/usr/bin/perl -w
use strict;
use warnings;
# Usage: STATUS = CreateHexFile(FILENAME, [STRINGS...])
sub CreateHexFile
{
defined $_[0] or return 0;
my $F = shift;
# Catch illegal characters in the file name
$F =~ m/[\x00-\x1F*?|<>]{1}/ and return 0;
# Join multiple arguments into one string
my $hexstr = join('', map(defined $_ ? $_ : '', @_));
# Remove everything except hexadecimal digits
$hexstr =~ tr|0-9A-Fa-f||cd;
local *FILE;
open(FILE, ">$F") or return 0; # Create binary file
binmode FILE;
# Convert hex string to a binary string and write it to the file.
# If there is an odd number of hexadecimal digits in $hexstr, then
# a zero digit is automatically added to the end at conversion.
print FILE pack('H*', $hexstr);
close FILE;
return 1;
}
####################################################################
# Create a list of hexadecimal numbers from 00 to FF:
my @numbers = map(sprintf('%.2X', $_), (0..255));
CreateHexFile('ASCII.BIN', @numbers);
DEFINT A-Z
DECLARE SUB CreateHexFile (FILENAME$, CONTENT$)
' These are hexadecimal digits that we will use to generate a list:
X$ = "0123456789abcdef"
' This is what we will write to the file...
MYLIST$ = "00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f "
' We use two FOR loops to generate the rest of the list:
FOR I = 2 TO 16
FOR J = 1 TO 16
MYLIST$ = MYLIST$ + MID$(X$, I, 1) + MID$(X$, J, 1) + " "
NEXT J
NEXT I
CLS
PRINT "This is the list of hexadecimal values that we will write to a
+file:"
PRINT
PRINT MYLIST$
PRINT
CreateHexFile "ASCIIBAS.BIN", MYLIST$
PRINT "File saved successfully."
PRINT
END
'
' This function creates a file in binary mode and writes some bytes in
+to it.
' The CONTENT$ string should hold a string of hexadecimal numbers.
' The numbers will be grouped into pairs, and each pair will
' be converted to a byte and written to the file.
' Non-hexadecimal characters will be ignored.
'
' This function can be used to create small binary files (less than 2K
+).
'
SUB CreateHexFile (FILENAME$, CONTENT$)
' Create a file...
OPEN FILENAME$ FOR OUTPUT AS #1
D = 0 ' We use this to count the hexadecimal digits
FOR I = 1 TO LEN(CONTENT$)
' P = INSTR("0123456789ABCDEF", UCASE$(MID$(CONTENT$, I, 1)))
' IF P > 0 THEN
' D = D + 1
' P = P - 1
' The above code block calls UCASE$() function every time,
' but we can eliminate that by doing the following instead:
'
P = INSTR("123456789abcdef0123456789ABCDEF", MID$(CONTENT$, I,
+ 1))
IF P > 0 THEN
D = D + 1
P = P AND 15
IF D AND 1 THEN
HI = P * 16
ELSE
C$ = CHR$(HI + P)
PRINT #1, C$;
END IF
END IF
NEXT I
' Write last digit if there were an odd number of digits:
IF D AND 1 THEN PRINT #1, CHR$(HI);
CLOSE #1
END SUB
#include <dir.h>
#include <stdio.h>
#include <string.h>
/*******************************************************************
// CATEGORY: File
// FUNCTION: CreateHexFile
// MODIFIED: 2025.9.28
// USAGE: int = CreateHexFile(*char FileName, *char HexString)
// BRIEF: Creates a binary file and writes some bytes into it
//
// This function creates a binary file and writes bytes into it.
// The function expects two string pointers, the first one pointing
// to a file name and the second one pointing to a string containing
// hexadecimal numbers. The function converts each hexadecimal
// digit pair into a byte and writes the bytes to a file.
// Non-hexadecimal digits in the arguments are ignored.
//
// If the file already exists, it will be deleted and replaced
// with the new content. The function returns 1 on success or
// zero if something went wrong.
//
// Note: Part of the original HexString will be overwritten with the
// binary content, so this function destroys the second argument.
//
// Usage: int = CreateHexFile(char *FileName, char *HexString)
*/
int CreateHexFile(char *FileName, char *HexString)
{
/* This lookup table helps us convert hexadecimal digits to integers
+ quickly */
char *LUT = "ABCDEFGHIJ.......KLMNOPQ.........................KLMNOP
+Q";
char c, hi, odd = 0;
int i = 0, j = 0;
FILE *f;
if ((f = fopen(FileName, "wb")) == NULL)
{
fprintf(stderr, "Error: Cannot create file.\n");
return 0;
}
while ((c = HexString[i++]) != 0)
{
if (c < 48 || c > 102)
continue; /* Non-hex char */
if ((c = LUT[c - 48]) < 65)
continue; /* Non-hex char */
c -= 65;
/* hex digit is now converted to an integer */
if ((odd = !odd) != 0)
hi = c << 4;
else
HexString[j++] = hi | c;
}
/* Save last digit if there are odd number of hex digits */
if (odd) HexString[j++] = hi;
/* Write converted binary data to file */
fwrite(HexString, j, 1, f);
fclose(f);
return 1;
}
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void main()
{
int i;
char CharTable[513];
char *ptr = CharTable;
/* Create a list of hexadecimal numbers from 00 to FF */
for (i = 0; i < 256; i++, ptr += 2)
sprintf(ptr, "%.2X", i);
CharTable[513] = 0;
mkdir("C:\\TEMP");
CreateHexFile("C:\\TEMP\\ASCII.BIN", CharTable);
}
// Here we create a character set that is necessary for
// writing bytes accurately in binary mode.
//
CHARSET = [];
for (i = 0; i < 256; i++)
CHARSET[i] = (i < 128 || i > 159) ? String.fromCharCode(i) : "\u20AC
+\x81\u201A\u0192\u201E\u2026\u2020\u2021\u02C6\u2030\u0160\u2039\u015
+2\x8D\u017D\x8F\x90\u2018\u2019\u201C\u201D\u2022\u2013\u2014\u02DC\u
+2122\u0161\u203A\u0153\x9D\u017E\u0178".charAt(i - 128);
// Create list of hex numbers from 00 to FF
// and write them to a file:
HexList = [];
for (i = 0; i < 256; i++)
HexList[i] = (i < 16 ? "0" : "") + i.toString(16);
CreateHexFile("ASCIIJS.BIN", HexList);
////////////////////////////////////////////////////////////////////
// This function creates a new binary file and writes bytes into it.
// The function expects a string argument or a list of strings
// containing hexadecimal numbers. The function converts each
// hexadecimal digit pair into a byte and writes the bytes
// to a file. Non-hexadecimal digits in the arguments are ignored.
//
// If the file already exists, it will be deleted and replaced
// with the new content. The function returns 1 on success or
// zero if something went wrong.
//
// This function can have one or more arguments.
// The first argument must be the file name, followed by a string
// or list or several string arguments or lists.
//
// Usage: INTEGER = CreateHexFile(FILENAME, [STRING OR LIST])
//
function CreateHexFile(FileName, Content)
{
Content = (typeof(Content) == "object") ? Content.join("") : Content
+ + "";
Content = Content.replace(/[^a-fA-F0-9]+/g, "");
if (Content.length & 1) Content += "0";
Content = Content.replace(/[a-fA-F0-9]{2}/g,
function (n) { return CHARSET[parseInt(n, 16)]; });
try
{
var FSO = new ActiveXObject("Scripting.FileSystemObject");
F = FSO.CreateTextFile(FileName, 1, 0);
F.Write(Content);
F.Close();
return 1;
}
catch (e) {}
return 0;
}
function CreateHexFile(FileName, Content)
if type(Content) == "table" then Content = table.concat(Content, "")
+ end
if type(Content) == "string" then Content = string.gsub(Content, "[^
+abcdefABCDEF%d]", "") end
local file, err = io.open(FileName, "wb")
if not file then return 0 end
if (#Content % 2 == 1) then Content = Content .. "0" end
local bytes = ""
for i=1,#Content,2 do
bytes = bytes .. string.char(tonumber(Content:sub(i, i+1), 16))
end
file:write(bytes)
file:close()
return 1
end
print("This program creates a file and write the following bytes into
+it:\n")
CharTable = ""
for i = 0, 255 do
CharTable = CharTable .. string.format("%02x ", i)
end
print(CharTable)
if CreateHexFile("C:\\DESKTOP\\ASCIILUA.BIN", CharTable) then
print("\nFile was written successfully.\n")
else
print("\nFile write failed.\n")
end
<?php
// Create a list of hexadecimal numbers from 00 to FF.
$hexstr = "";
for ($i = 0; $i < 256; $i++)
$hexstr .= toHex($i) . " ";
echo "This PHP program creates a file and writes the following charact
+ers into it:<P><TT>";
echo $hexstr;
$f = dirname(__FILE__) . "/ASCIIPHP.BIN";
CreateHexFile($f, $hexstr);
echo "<P>DONE.";
////////////////////////////////////////////////////////////////////
// USAGE: STRING = toHex(INTEGER)
// This function converts an integer to a two-digit hexadecimal
// number between 00 and FF. If the number is negative, the
// function will return 00. If the number is 255 or greater, the
// function will return FF. Anything in between will be converted
// to a two-digit hexadecimal number.
function toHex($c)
{
if ($c <= 0) return "00";
if ($c >= 255) return "ff";
return ($c < 16 ? "0" : "") . dechex($c | 0);
}
////////////////////////////////////////////////////////////////////
// USAGE: Status = CreateHexFile(FileName, HexString)
// This function creates a binary file. The first argument must be
// the name of the file. The second argument should be a string
// that hold hexadecimal numbers. Each 2-digit number is
// converted to a byte and written to the file.
// Non-hex characters are ignored.
// The function returns 1 on success or zero if an error occurred.
function CreateHexFile($FileName, $Content)
{
$Status = 1;
$Output = "";
// Remove all non-hexadecimal characters:
$Content = preg_replace("/[^0-9a-fA-F]+/", "", $Content);
// Make sure we have an even number of digits.
if (strlen($Content) & 1) $Content .= "0";
// Convert hexadecimal numbers to bytes
for ($i = 0; $i < strlen($Content); $i += 2)
$Output .= chr(hexdec(substr($Content, $i, 2)));
// Create file
$f = fopen($FileName, "wb");
if (!fwrite($f, $Output)) $Status = 0;
fclose($f);
return $Status;
}
?>
import os;
import re;
####################################################################
# USAGE: INTEGER = CreateHexFile(FILENAME, [CONTENT])
# This function creates a file and writes bytes in binary mode.
# The bytes have to be provided as a string or list of
# hexadecimal numbers. Each byte must be formatted as
# a 2-digit hexadecimal number.
#
# The function returns 1 on success or 0 on error.
#
# The following example creates a file and writes "ABC"
# NULL-terminated string into the file:
#
# CreateHexFile("testing.txt", " 41 42 43 00 ")
#
def CreateHexFile(FileName, Content = []):
try:
# Convert Content to a string and then
# remove everything except hexadecimal digits:
Content = re.sub("[^a-fA-F0-9]+", "", repr(Content))
# Line up the hexadecimal numbers in pairs
# and convert them to integers:
Content = map(lambda n: int(n, 16), re.findall('..', Content))
# Create the file and open for writing in binary mode:
myfile = open(FileName, "wb")
# Detect Python version by doing a simple division and
# looking for the remainder. Python 2 always drops the
# remainder when doing a division, so if the result
# of 1/2 is zero, then the interpreter is Python 2.
Python2 = (1 / 2) == 0
# Convert the list of integers to bytes
# and write them to the file:
if Python2:
myfile.write("".join(map(chr, Content)))
else:
myfile.write(bytearray(Content))
myfile.close()
except IOError:
return 0
return 1
#CreateHexFile("C:\\DESKTOP\\TESTING456.BIN", " A0 01 CB C3 30 40 50 6
+0 70 80 90 A0 B0 C0 D0 E0 F0 FF 41 42 0D")
CreateHexFile("ASCIIPY.BIN", ["CB", "C3", "00", "9A", "80", "41", "0D"
+])
######################################################################
# USAGE: CreateHexFile FILENAME [LIST]
# This function creates a binary file and writes some bytes in it.
# The first argument should be the full name of the file to be
# created. The following arguments must be pairs of hexadecimal
# digits which are converted to bytes and written to the file.
# Finally, the function creates a global variable named $SUCCESS
# and will write the number of bytes written into this variable.
# If an error occurs, then this variable will hold an empty string.
# If the function was called with only one argument, meaning that
# no bytes were expected to be written, then the function will
# create a file and leave it blank, and $SUCCESS will be set to 0.
#
# Example:
#
# CreateHexFile "myfile.tmp" 00 c3 9d 80 7e 92 23 ff 00 2c
# if [[ $SUCCESS ]]; then
# echo "$SUCCESS bytes written successfully."
# else
# echo "Failed to create file."
# fi
#
function CreateHexFile
{
SUCCESS=''
local filename="$1"
local bytecount=0
local byte
local hex
shift
# Create the file
> "$filename"
# File exists?
if [[ -f $filename ]]; then
# Make sure file length is zero at this point:
local filelen=$(stat --printf="%s" "$filename")
if [[ $filelen -gt 0 ]]; then
return 0
fi
SUCCESS=0
# Convert hexadecimal numbers to bytes
# and write them to the file:
for hex in "$@"; do
# Remove everything except hexadecimal digits
hex=$(printf '%s' "${hex//[![:xdigit:]]}")
for (( i=0; i<${#hex}; i+=2 )); do
# Take two digits at a time
byte="\\x${hex:i:2}"
# Write it to the file one byte at a time
printf "$byte" >> "$filename"
# Count number of bytes sent to the file
bytecount=$((bytecount + 1))
done
done
if [[ $bytecount -gt 0 ]]; then
local filelen=$(stat --printf="%s" "$filename")
if [[ $filelen -eq $bytecount ]]; then
SUCCESS=$filelen
fi
fi
else
echo "Error: Cannot create file - $filename" >&2
fi
}
$MyList = " 00 01 02 03 04 05 06 07 "
CreateHexFile "ASCIIBASH.BIN" $MyList
' This VBA macro works in Excel; it will not work in
' Google Sheets, OpenOffice, or GNumeric.
' Insert the following into an empty new Excel spreadsheet and
' paste the following two macros. Then run the two that begin with
' the word "Action"
Sub Action_CreateCharTable()
HexDigits = "0123456789ABCDEF"
' Fill in values from 00 to FF
For Column = 1 To 16
For Row = 1 To 16
CellName = Chr(Column + 64) & Row
HexValue = "'" & Mid(HexDigits, Row, 1) & Mid(HexDigits, C
+olumn, 1)
Range(CellName).Value = HexValue
Next
Next
' Align values in the center of each cell
Range("A1:P16").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
End Sub
Sub Action_SaveFile()
' Collect hexadecimal numbers from cells into a string
HexString = ""
For Row = 1 To 16
For Column = 1 To 16
CellName = Chr(Column + 64) & Row
HexString = HexString & Range(CellName).Value
Next
Next
Call CreateHexFile("ASCII.BIN", HexString)
End Sub
' USAGE: Call CreateHexFile(FileName, StringContent)
Sub CreateHexFile(FileName, Content)
' Create the file
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.CreateTextFile(FileName, 1, 0)
If VarType(Content) = vbString Then
D = 0 ' Number of hexadecimal digits we have encounter
+ed
Output = "" ' Binary string output
For I = 1 To Len(Content)
' The following line captures digits and uppercase and low
+ercase letters (A-F) and
' outputs a number between 0 and 16. If it's zero, then th
+at means
' the input character was not a hexadecimal digit.
P = InStr("123456789abcdef0123456789ABCDEF", Mid(Content,
+I, 1))
If P > 0 Then
D = D + 1
P = P And 15
If D And 1 Then
' Store high nibble in U
U = P * 16
Else
' Combine high nibble and low nibble U + P
Output = Output & Chr(U + P)
End If
End If
Next
' Write last digit if there were an odd number of digits:
If D And 1 Then Output = Output & Chr(U)
F.Write Output
End If
F.Close
End Sub
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File Name: CreateHexFile.asm
;
; This program creates a file called asciiasm.bin in the current
; directory and writes 256 bytes into it. It's a simple example
; program written in assembly language for Linux to be compiled
; with nasm. This program is designed so it can be built either
; into an x86 or x86_64 executable without requiring any changes
; to the source code.
;
; To build a 64-bit Linux executable, enter the following
; commands in the terminal:
;
; nasm -f elf64 -o CreateHexFile.o CreateHexFile.asm
; ld -s -no-pie -z noseparate-code CreateHexFile.o -o CreateHexFi
+le
; strip -s CreateHexFile
;
; To build a 32-bit executable, run the following commands:
;
; nasm -f elf32 -o CreateHexFile.o CreateHexFile.asm
; ld -s -no-pie -z noseparate-code -m elf_i386 CreateHexFile.o -o
+ CreateHexFile
; strip -s CreateHexFile
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
%if __BITS__ == 64
%define _AX RAX
%define _BX RBX
%define _CX RCX
%define _DX RDX
%define _SI RSI
%define _DI RDI
%define _BP RBP
%macro EXIT 1 ; EXIT requires 1 argument
MOV RDI,%1 ; Error code will be placed into RDI
MOV RAX,60 ; Sys_exit is function #60 in 64-bit kernel
SYSCALL
%endmacro
%else
%macro EXIT 1 ; EXIT requires 1 argument
MOV EBX,%1 ; Error code will be placed into EBX
MOV EAX,1 ; Sys_exit is function #1 in 32-bit kernel
INT 0x80
%endmacro
%define _AX EAX
%define _BX EBX
%define _CX ECX
%define _DX EDX
%define _SI ESI
%define _DI EDI
%define _BP EBP
%endif
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROGRAM DATA SECTION ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SECTION .data
FileName:
DB "asciiasm.bin", 0
Msg_success:
DB "File created successfully.", 10, 0
Msg_failure:
DB "File could not be created.", 10, 0
Msg_welcome:
DB 10, 10, "The following bytes will be written to a file: ", 10,
+ 10
HexCode:
DB "00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f", 10
DB "10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f", 10
DB "20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f", 10
DB "30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f", 10
DB "40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f", 10
DB "50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f", 10
DB "60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f", 10
DB "70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f", 10
DB "80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f", 10
DB "90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f", 10
DB "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af", 10
DB "b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf", 10
DB "c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf", 10
DB "d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df", 10
DB "e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef", 10
DB "f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff", 10, 0
SECTION .text
GLOBAL _start
_start:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROGRAM BEGINS HERE ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This part of the source code is identical for both x86 and
; x86_64 builds. The '_' in front of the registers stands for
; either an 'E' or an 'R' which will be substituted by nasm
; when it is time to compile the code.
MOV _SI,Msg_welcome ; Inform the user about what we are doing
CALL PrintText
MOV _SI,HexCode
MOV _DI,_SI
CALL Hex2Str ; Convert hexadecimal digits into binary bytes
; Hex2Str will place the length of string into _DX and the string
; pointer will be left in _DI, which is exactly where
; CreateFile expects them to be:
MOV _SI,FileName
CALL CreateFile
JNC Success_Exit ; CreateFile sets carry flag on error
MOV _SI,Msg_failure
CALL PrintText ; Print error message
EXIT 1
Success_Exit:
MOV _SI,Msg_success
CALL PrintText ; Print success message
EXIT 0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CATEGORY: File
; FUNCTION: CreateFile
; CREATED: 2026.1.23
; PLATFORM: Linux x86 or x86_64
; DESCR: Creates a binary file
;
; This function creates a new file (if the file already exists,
; then it deletes its contents) and writes some bytes into it.
;
; DS:_SI <= Pointer to ASCIIZ file name
; DS:_DI <= Pointer to data to be written
; _DX <= Number of bytes to write
; _CX => Number of bytes written
; CF => Carry Flag will be set on error
; Modifies: _CX,Flags
;
CreateFile:
PUSH _AX
PUSH _BX
PUSH _DX
PUSH _SI
PUSH _DI
%if __BITS__ == 64
PUSH R14
PUSH R13
PUSH R12
PUSH R11
; I entered the following into Google search:
; Write assembly code that creates a file and writes some bytes into i
+t and results in a linux elf64 executable.
; This gave me a starting point, so then I could change things around
+a bit...
; Now, whoever designed the x86_64 Linux kernel decided that sys calls
+ will have completely
; different numberings and arguments are to be passed in different reg
+isters than x86.
; That person should be put in jail!!
; First of all, we will save the values of RDI and RDX in other regist
+ers.
MOV R14,RDI
MOV R13,RDX
; Create the file.
MOV RAX,2 ; The function number for sys_open is 2 in 64-
+bit mode.
; The kernel expects the following argument(s):
; RDI <= Pointer to the ASCIIZ string that holds the file name.
; RSI <= The file open mode
; RDX <= The permission flags
MOV RDI,RSI
MOV RSI,65 ; CREATE=1 | TRUNCATE=64
MOV RDX,0o644 ; File permissions: rw-r--r--
SYSCALL ; SYSCALL always modifies RAX, RCX, and R11
MOV R12,RAX ; Save the file descriptor in R12
; The file descriptor will be a negative number if sys_open failed
+.
SHL RAX,1 ; Shift highest bit of RAX into CF
JC CreateFile_Error_x64 ; Jump if RAX was a negative number
; Write bytes to the file.
MOV RAX,1 ; The function number for sys_write is 1 in 64
+-bit mode.
; The 64-bit kernel expects arguments in RDI, RDX, and RSI:
MOV RDI,R12 ; Load file descriptor from R12
MOV RDX,R13 ; Load number of bytes to write from R13
MOV RSI,R14 ; Load data pointer from R14
SYSCALL ; SYSCALL always modifies RAX, RCX, and R11
XCHG RDX,RAX ; RDX <= Save number of bytes written
; Close the file.
MOV RAX,3 ; The function number for sys_close is 3 in 64
+-bit mode.
MOV RDI,R12 ; Load the file descriptor from R12
SYSCALL ; SYSCALL always modifies RAX, RCX, and R11
MOV RCX,RDX ; RCX <= Load number of bytes written
SHL RDX,1 ; Is this a negative number?
JNC CreateFile_Exit_x64
CreateFile_Error_x64:
XOR _CX,_CX ; Zero bytes written
STC
CreateFile_Exit_x64:
POP R11
POP R12
POP R13
POP R14
%else ; 32-bit version of the code follows next:
; Create and Open File
MOV EAX,5 ; The function number for sys_open is 5 in 32-
+bit mode.
; The 32-bit kernel expects arguments in EBX=filename, ECX=flags,
+and EDX=mode.
MOV EBX,ESI ; EBX <= File name
MOV ESI,EDX ; Save number of bytes to write in ESI tempora
+rily
MOV ECX,65 ; CREATE=64 | WRITEONLY=1
MOV EDX,0o644 ; File permissions: rw-r--r--
INT 0x80
; The kernel returns the file descriptor returned in EAX.
MOV EBX,EAX ; EBX <= Save file descriptor
; The file descriptor will be a negative number if sys_open failed
+.
SHL EAX,1 ; Shift highest bit of EAX into CF
JC CreateFile_Error_x86 ; Jump if EAX was a negative number
MOV EAX,4 ; The function number for sys_write is 4 in 32
+-bit mode.
; The 32-bit kernel expects arguments in EBX=file_descriptor, ECX=
+buffer, and EDX=length.
; EBX is already set from above
MOV ECX,EDI
MOV EDX,ESI ; Restore number of bytes to write from ESI
INT 0x80
MOV ECX,EAX ; Save number of bytes written in ECX
MOV EAX,6 ; The function number for sys_close is 6 in 32
+-bit mode.
INT 0x80 ; Expects file descriptor in EBX which is alre
+ady set.
MOV EAX,ECX
SHL EAX,1 ; Shift highest bit of EAX into CF
JNC CreateFile_Exit ; Exit normally if it was a positive nu
+mber.
CreateFile_Error_x86:
XOR ECX,ECX
STC
%endif
CreateFile_Exit:
POP _DI
POP _SI
POP _DX
POP _BX
POP _AX
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CATEGORY: Stdio
; FUNCTION: PrintText
; MODIFIED: 2026.1.22
; PLATFORM: Linux x86 or x86_64
; DESCR: Prints an ASCIIZ string to stdout
;
; This function prints an ASCIIZ string to stdout.
;
; DS:_SI <= Pointer to ASCIIZ string
; Modifies: None
;
PrintText:
PUSHF
PUSH _SI
PUSH _DI
PUSH _DX
PUSH _AX
CALL StrLen
%if __BITS__ == 64
MOV RDI,1 ; File descriptor 1 is STDOUT
MOV RAX,1
SYSCALL
%else
PUSH ECX
MOV ECX,ESI ; ECX <= Pointer to text
MOV EBX,1 ; File descriptor 1 is STDOUT
MOV EAX,4
INT 0x80
POP ECX
%endif
POP _AX
POP _DX
POP _DI
POP _SI
POPF
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CATEGORY: String
; FUNCTION: StrLen
; MODIFIED: 2026.1.22
; PLATFORM: x86 or x86_64, OS independent
; DESCR: Returns the length of an ASCIIZ string
;
; This function finds the terminating NULL character at the end of
; a string and returns the length of string in EDX.
;
; DS:_SI <= Pointer to ASCIIZ string
; _DX => Length of string
; Modifies: _DX,Flags
;
StrLen:
PUSH _SI
PUSH _CX
PUSH _AX
XOR _DX,_DX ; Reset byte counter.
MOV _CX,_SI
NEG _CX
DEC _CX ; ECX <= maximum allowed length of string
CLD ; We will be reading in forward direction
StrLen_Loop:
LODSB
TEST AL,AL
JE StrLen_EndOfString
INC _DX
LOOP StrLen_Loop
StrLen_EndOfString:
POP _AX
POP _CX
POP _SI
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CATEGORY: String
; FUNCTION: Hex2Str
; MODIFIED: 2026.1.22
; PLATFORM: x86 or x86_64, OS independent
; DESCR: Converts hexadecimal digits to binary string
;
; This function converts an ASCIIZ string of hexadecimal numbers
; to binary string. The numbers are grouped into pairs from left to
; right and then each pair is converted to a byte. Non-hexadecimal
; characters are ignored. If there's an odd number of hexadecimal
; digits in the input string, then the function pretends that there
; is a zero at the end completing the last byte.
;
; DS:_SI <= Pointer to ASCIIZ string containing hex digits
; ES:_DI <= Pointer to destination memory area
; _DX => Number of bytes written
; Modifies: _DX,Flags
;
Hex2Str:
PUSH _SI
PUSH _DI
PUSH _AX
XOR _DX,_DX ; Reset byte counter.
CLD ; Read/write operations move in forward direction.
; We will use the high 4 bits of AH to store the upper nibble of
; the byte. AH will be set to 255 when it is empty or uninitialized.
Hex2Str_Reset:
MOV AH,255
Hex2Str_Loop:
LODSB
TEST AL,AL
JE Hex2Str_EndofString
CMP AL,'0'
JB Hex2Str_Loop ; Skip non-hex char
CMP AL,'f'
JA Hex2Str_Loop ; Skip non-hex char
CMP AL,'9'
JA Hex2Str_NonDigit
SUB AL,'0'
JMP Hex2Str_SaveValue
Hex2Str_NonDigit:
OR AL,32
SUB AL,'a'
CMP AL,5
JA Hex2Str_Loop ; Skip non-hex char
ADD AL,10
Hex2Str_SaveValue:
CMP AH,255
JE Hex2Str_StoreHigh
; Got second hex digit. Now, merge them together and save byte.
OR AL,AH
STOSB
INC _DX
JMP Hex2Str_Reset
Hex2Str_StoreHigh:
SHL AX,12 ; Transfer low 4 bits from AL into high 4 bit
+s of AH
JMP Hex2Str_Loop ; Stored first hex digit.
Hex2Str_EndofString: ; Save last byte if odd number of digits.
CMP AH,255
JE Hex2Str_Exit
MOV AL,AH
STOSB
INC _DX
Hex2Str_Exit:
POP _AX
POP _DI
POP _SI
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Having a 64 bit x86-64 CPU and a 2 TB drive is a curse, not a blessing, and watching the page file grow to 75 GB because your Perl process went out of control leaking memory at 100% CPU on 1 core and its going to be a few seconds or some dozens of seconds for you to click or type your way to killing that 64 bit Perl PID because it has claimed chattel ownership of your SSD (paging file).
Now, since Windows NT 3.0 is a XOpen Group certified IEEE POSIX 1991 operating system, where on earth is the POSIX 1991 ulimit command in Win2000, WinXP, Win7, and Win10 when you need it?
We know Windows OS has the POSIX ulimit/setrlimit() commands, and that is guaranteed by a very expensive piece of paper from 1991.
After extreme confusion, and reverse engineering and studying other SW on Github, here is a simple script of a Perl on Windows process asking the NT Kernel to enforce POSIX RAM/memory limit controls on itself (its own PID number) using resource limits/quotas/counter values that the Perl process itself decided is correct for itself.
For whatever reason, in Windows (NT Kernel) architectural design, Microsoft decided to organize the POSIX compliant per-process/per-user multi user time sharing/process resource limit API, to live underneath Windows's CRON API/"Scheduled Tasks" API which makes no sense to me.
This script proves you don't need to makes registry changes, or get UAC/Administrator privileges/C debugger privileges, for a process to turn on, on to itself, Windows kernel resource hard limit enforcement.
Make a 50 MB string with a 100 MB process memory limit:
C:\sources>perl w32jobobj.pl 50 100
Opened process PID 14332Success, Perl assembled the 52428812 bytes lon
+g string.
It will now be printed to STDOUT. 2 kernel handles were leaked in thi
+s code.
This is a good time to hit Ctrl-C instead of hitting Spacebar or Enter
+.Press any
key to continue . . .
Demo script of how to do it. It needs some polishing, and I am leaking the 2 handle objects I created. But it proves the feature is alive and well and fully functional. No docker or virtual machine nonsense needed to protect yourself from your own runaway memory leaks/infinite loops.
I had need to browse, repeatedly for different numbers, a list of words and phrases
whose Scrabble scores[1] were that number. So I wrote this little script. It's not much but perhaps can help someone.
And obviously if anyone has any corrections or suggestions, I'm all ears.
use strict;
use warnings;
use Unicode::Normalize;
use List::Util 'sum0';
my %values;
@values{'A'..'Z'} = @values{'a'..'z'} = (1, 3, 3, 2, 1, 4, 2, 4, 1, 8,
+ 5, 1, 3, 1, 1, 3, 10, 1, 1, 1, 1, 4, 4, 8, 4, 10);
print 'What score? ';
my $score = <>;
$score =~ s/^(0|\s)+//;
$score =~ s/\s+$//;
die "um, a positive integer$/" unless $score =~ /^[0-9]+$/;
print 'What length, at least? (or blank for 1) ';
my $min = <>;
$min =~ s/^(0|\s)+//;
$min =~ s/\s+$//;
$min = 1 unless $min =~ /^[0-9]+$/;
print 'What length, at most? (or blank for no max) ';
my $max = <>;
$max =~ s/^(0|\s)+//;
$max =~ s/\s+$//;
$max = 0 unless $max =~ /^[0-9]+$/;
print 'What regex? (no slashes; or blank for any) ';
my $re = <>;
chomp $re;
$re = '.*' if $re eq '';
$re = qr/$re/i;
my %good;
my %dicts = (
# a hash of pairs like: '/path/to/wordlist' => 'nickname_for_the_w
+ordlist'
);
for my $file (keys %dicts) {
open my $fh, '<', $file or next;
while (<$fh>) {
next if /\d/;
s/\W|_//g;
$_ = NFKD $_;
s/\pM//g;
next unless $min <= length;
next unless $max == 0 or $max >= length;
next unless $score == sum0 map $values{$_}, split //;
next unless m/$re/;
undef $good{lc$_}{$dicts{$file}}
}
}
$, = v9;
$\ = $/;
print $_, join ',', sort keys %{$good{$_}} for sort keys %good
Eskild Hustvedt has written a tool, jesgemini, to convert a number of static site generators to Gemtext.
jesgemini is a minimal static site (capsule) generator for the Gemini
Protocol. It's designed to be "compatible" with
sites built using other static site generators. Compatible here being a
relative term, basically meaning it can slurp up a directory tree of markdown
files meant for a web-SSG, and spit out a usable tree of
gemtext.
It has an external dependency on lowdown by Kristaps Dzonsons. The code for jesgemini is available at Source Hut: git clone https://git.sr.ht/~zerodogg/jesgemini under the GPLv3.
I have been feeling rather deprived of Perl activity the last few months... so when I was playing a card game on my phone (a simple one that I have >95% win rate on), but had spent quite a few attempts (it allows undo/restart), I decided to program in as much of the "deal" as I could see, and see if I could get Perl to find a route to one or more of the as-of-yet unseen reserve cards (at which point, I'd be able to try to move forward and maybe even win this hand).
Stock is 1-at-a-time (not the default 3-at-a-time)
Foundations always start at Ace
Tableau alternates color, descending, but allows wrapping from 2-A-K
With that, I hacked together a solver that gave a 50% chance at every "decision point", then went through thousands of games. It was never able to find a path to reveal the next card (the first ? in the deal), so I'm pretty confident that this particular deal isn't winnable.
I figured I might as well share this CUFP, even if it's not overly groundbreaking (and definitely not great code).
I recently changed my at home monitoring of the CISA Known Exploited Vulnerabilities feed (More information on KEV here) to make the alerting more accessible. While I monitor some products we use at work this is not a business critical service.
This quick and dirty script uses Mojolicious to hit this CISA KEV API, read a local file to match against target vendors, products or both, logging matches to a local cache so we don't keep reporting on the same thing and sending a notification to my local gotify instance (clients for web, Android etc.).
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Mojo::Log;
use Mojo::File;
use Mojo::JSON qw(decode_json encode_json);
use Mojo::UserAgent;
# cisa-kev-mon
# monitor the CISA KEV feed
# * Send notifications to gotify
# * Log them locally so we don't keep reporting on the same thing.
# For further info on CISA Known Exploited Vulnerablities visit:
# https://www.cisa.gov/known-exploited-vulnerabilities
# logging
my $log = Mojo::Log->new( path => 'cve_mon.log', level => 'debug' );
# read list software we're interested in
unless ( -e 'targets.json' ){
$log->fatal( 'no targets.json' );
die 'No targets.json';
}
# get targets
my @targets = @{ decode_json( Mojo::File->new( 'targets.json' )->slurp
+ ) };
# gotify notification server config
unless ( $ENV{GOTIFY_URL} && $ENV{GOTIFY_TOKEN} ){
$log->fatal( 'Check Gotify env vars, GOTIFY_URL & GOTIFY_TOKEN' );
die 'Fail: Check Gotify env vars, GOTIFY_URL & GOTIFY_TOKEN';
}
my $gotify_url = $ENV{GOTIFY_URL};
my $gotify_token = $ENV{GOTIFY_TOKEN};
# cve.org base url
my $cve_url = 'https://www.cve.org/CVERecord?id=';
# cisa recent json feed
my $cisa_url = 'https://www.cisa.gov/sites/default/files/feeds/known
+_exploited_vulnerabilities.json';
# local cache so we don't report on already seen CVEs
my $cve_cache = Mojo::File->new( 'seen_cves.json' );
# Fetch JSON
my $ua = Mojo::UserAgent->new;
my $res = $ua->get( $cisa_url )->result;
# die if we can't get the JSON feed
unless ( $res->is_success ){
$log->error( 'Failed to fetch CISA feed: ' . $res->message );
die 'Failed to fetch CISA feed: ' . $res->message;
}
my $data = decode_json( $res->body );
my @vulns = @{ $data->{vulnerabilities} };
# Load existing CVEs from local cache
my %seen_cves;
if ( -e $cve_cache ){
%seen_cves = %{ decode_json( $cve_cache->slurp ) };
}
# Filter existing & collect new CVEs
my @new_cves;
foreach my $vuln ( @vulns ) {
my $vendor = $vuln->{vendorProject};
my $product = $vuln->{product};
my $cve_id = $vuln->{cveID};
# skip if the CVE has been logged before
next if $seen_cves{$cve_id};
# for each target
for my $target( @targets ){
my $matches = 0;
# Match both vendor and product
if (defined $target->{vendor} && defined $target->{product}) {
+
$matches = ($vendor =~ /\Q$target->{vendor}\E/i && $produc
+t =~ /\Q$target->{product}\E/i);
}
# match vendor
elsif (defined $target->{vendor}) {
$matches = ($vendor =~ /\Q$target->{vendor}\E/i);
}
# match product
elsif (defined $target->{product}) {
$matches = ($product =~ /\Q$target->{product}\E/i);
}
if ($matches) {
# post to gotify
my $res = $ua->post( $gotify_url =>
{ 'X-Gotify-Key' => $gotify_token } =>
form => {
title => 'cisa KEV CVE alert',
message => "New CVE: $vendor - $product $cve_url$c
+ve_id",
priority => 5,
}
)->result;
unless ( $res->is_success ){
$log->fatal( 'Failed to post to gotify: ' . $res->code
+ . ' - ' . $res->message );
die 'Failed to post to gotify: ' . $res->code . ' - '
+. $res->message;
}
# add to local cache
push @new_cves, $vuln;
$seen_cves{$cve_id} = 1;
last;
}
}
}
# Output
if ( @new_cves ) {
say 'New vulnerabilities found:';
foreach my $cve ( @new_cves ) {
say "[$cve->{cveID}] $cve->{vendorProject} $cve->{product}: $c
+ve->{vulnerabilityName} (Added: $cve->{dateAdded})";
}
} else {
say 'No new vulnerabilities for your monitored vendors/products.';
}
# Save updated seen CVEs to local file
Mojo::File->new( 'seen_cves.json' )->spew( encode_json( \%seen_cves )
+);
New vulnerabilities found:
[CVE-2025-49704] Microsoft SharePoint: Microsoft SharePoint Code Injec
+tion Vulnerability (Added: 2025-07-22)
[CVE-2025-49706] Microsoft SharePoint: Microsoft SharePoint Improper A
+uthentication Vulnerability (Added: 2025-07-22)
[CVE-2025-53770] Microsoft SharePoint: Microsoft SharePoint Deserializ
+ation of Untrusted Data Vulnerability (Added: 2025-07-20)
Working in large multi vendor organisations, many of whom are outsourced, we don't always hear about things promptly, if at all. Forewarned is forearmed as the adage goes. Screenshot of the Gotify Android app output.
I even have a test (gated by environment variables) which can generate the initrd by exporting pieces of an Alpine docker container, and then run Linux with that initrd inside qemu.
From The Weekly Challenge 329.1: You are given a string containing only lower case English letters
and digits. Write a script to replace every non-digit character with a
space and then return all the distinct integers left.
The replacement of non-digit characters with spaces seemed kind of pointless since you can extract the integers without doing that. But I challenged myself to make the action of replacing with spaces meaningful.
For amusement purposes what I did was this: After converting letters to spaces, I wrote the string to a PNG file and OCR'd it using a hosted OCR service, via OCR::OcrSpace. That service returns a json file with each "word" along with it's own bounding box information and other data, I ignore everything except the extracted integer "words", push them into an array and done!
use GD;
use JSON;
use OCR::OcrSpace;
sub write_image{
my($s) = @_;
my $width = 500;
my $height = 500;
my $image_file = q#/tmp/output_image.png#;
my $image = GD::Image->new($width, $height);
my $white = $image->colorAllocate(255, 255, 255);
my $black = $image->colorAllocate(0, 0, 0);
$image->filledRectangle(0, 0, $width - 1, $height - 1, $white);
my $font_path = q#/System/Library/Fonts/Courier.ttc#;
my $font_size = 14;
$image->stringFT($black, $font_path, $font_size, 0, 10, 50, $s);
open TEMP, q/>/, qq/$image_file/;
binmode TEMP;
print TEMP $image->png;
close TEMP;
return $image_file;
}
sub counter_integers{
my($s) = @_;
my @numbers;
$s =~ tr/a-z/ /;
my $image = write_image($s);
my $ocrspace = OCR::OcrSpace->new();
my $ocrspace_parameters = { file => qq/$image/,
apikey => q/XXXXXXX/,
filetype => q/PNG/,
scale => q/True/,
isOverlayRequired => q/True/,
OCREngine => 2};
my $result = $ocrspace->get_result($ocrspace_parameters);
$result = decode_json($result);
my $lines = $result->{ParsedResults}[0]
->{TextOverlay}
->{Lines};
for my $line (@{$lines}){
for my $word (@{$line->{Words}}){
push @numbers, $word->{WordText};
}
}
return join q/, /, @numbers;
}
MAIN:{
print counter_integers q/the1weekly2challenge2/;
print qq/\n/;
print counter_integers q/go21od1lu5c7k/;
print qq/\n/;
print counter_integers q/4p3e2r1l/;
print qq/\n/;
}
<jc> Why do people persist in asking me stupid questions?
<Petruchio> <insert mutually recursive response>
--an exchange from #perlmonks on irc.slashnet.org(2 March 2009 1345 EST)
I don't know how "cool" this is (it's cool to me) but this is a small script
I wrote 13 years ago. It simply converts and prints out the Perl version contained in the built-in
variable $] to the string as we usually see it when we are discussing Perl
releases. Just run it, you'll see what I mean ;-).
#!/usr/bin/env perl
# First created: 2012-05-08
# Last modified: 2012-08-26T01:37:48 UTC-04:00
use strict;
my $pow = 2;
my $test_v = $ARGV[0] || $];
my @qiu = split(q/[._]/ => $test_v);
@qiu[1 .. @qiu] = map {sprintf(q[%u],$_/10**$pow++)}
map {unpack "A4 A4",$_ * 10**3 } @qiu[1 .. $#qiu];
my $tuple_perlversion = join q[.], grep{length($_)} @qiu;
print "$tuple_perlversion\n";
In the past few days, I have been testing various different ways to convert binary numbers to decimal. In the next little script I demonstrate two ways that I designed. One is called Bin2BigInt() which looks slower, and the other is Bin2Dec(). They both do the exact same thing but using a different scheme. You pass a binary number such as "1110101" and the functions output an integer in base 10, which could be any length. Bin2Dec() uses tr/// operator and a regex replace to perform the addition on bigints, while Bin2BigInt() relies on a sub called BIGADD() which adds two bigints digit by digit and returns the sum.
A third scheme could implement a little trick to speed up the conversion by looking for consecutive patches of 1s in the input string... So, let's say we have a number like this: "1111111111110000000000" In this case, we could calculate 2^22 and then subtract 2^10 like so:
10000000000000000000000 = 4194304
- 10000000000 = 1024
---------------------------------------
1111111111110000000000 = 4193280 <= This is the result we're looking
+ for!
The idea is that performing a single subtraction would be faster than performing an addition every time we encounter a '1' digit in the input string. But I'm not sure how much time this would gain. And the gain would be absolutely non-existent for numbers like "1010101011101010101000101010101010101010000000000101010100101010101001101100000101010101" in which there aren't too many repeating 1s.
#!/usr/bin/perl -w
use strict;
use warnings;
$| = 1;
RunTests(
'', '0',
'what?', '0',
'0', '0',
'1', '1',
'11', '3',
'0001', '1',
'1011', '11',
'1111', '15',
'11111111', '255',
'yay 1__1 Lol', '3',
'11111111111111111111111111111111', '4294967295',
'10101010101010101010101010101010', '2863311530',
'00000000001111111111110000000000', '4193280',
'100011111111110011111011001101000', '4831442536',
+ # 33-bit value
'11111111111000111111111100111110110010001000110', '1406773524818
+62', # 47-bit value
'111111111111000000000000000000000000000000000000', '281406257233
+920', # 48-bit value
'1111111111110000000000000000000000000000000000000', '56281251446
+7840', # 49-bit value
'0000111000111000111000111000111000111000111000111000111000111000
+', '1024819115206086200', # 60-bit value
'1111111111111111100000000000000001111111111111111000000000000000
+', '18446603338368647168', # 64-bit value
'1100111100100110000001111110111000110101010101010101010101010101
+', '14926626734644483413', # 64-bit value
'1111111111111111111111111111111111111111111111111111111111111111
+', '18446744073709551615', # 64-bit value
'1000000000000000000000000000000000000000000000000000000000000000
+0', '18446744073709551616', # 65-bit value
# 112-bit value:
'1111111111111111111111111111111111111111111111111111111111111111
+111111111111111111111111111111111111111111111111', '51922968585348276
+28530496329220095',
'1000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000', '5192296858534827
+628530496329220096',
# 360-bit value:
'1111111111111111111111111111111111111111111111111111111111111111
+111111111111111111111111111111111111111111111111111111111111111111111
+111111111111111111111111111111111111111111111111111111111111111111111
+111111111111111111111111111111111111111111111111111111111111111111111
+111111111111111111111111111111111111111111111111111111111111111111111
+11111111111111111111', '234854258277383322788948059678933702737568254
+8908319870707290971532209025114608443463698998384768703031934975',
# 1500-bit value:
'1000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000000000000000', '175373310
+552170193738137939801404289967620079401654144120378990123954819252816
+611018285404432924846308265752033977187586996472744707349798770855194
+590023504239449782426645486322434013557917314732683410921700693147256
+777291324731712626918096946574803223325262758757211677546245866805651
+778980548549427903371569771051088289237163133803665023766376585960668
+373517816863916485209966135263316668342549760000875266777645294402170
+91269193357761841856604274688'
);
print "\nDon't panic. Your computer did not crash.\nThe following oper
+ation may take a few seconds.\n";
print "\nConverting 4096-digit binary number to decimal using Bin2Dec(
+) and Bin2BigInt()\nPlease wait...";
# Generate a 4096-digit binary number:
RunTests('1' . '0' x 4096, '104438888141315250669175271071662438257996
+424904738378038423348328395390797155745684882681193499755834089010671
+443926283798757343818579360726323608785136527794595697654370999834036
+159013438371831442807001185594622637631883939771274567233468434458661
+749680790870580370407128404874011860911446797778359802900668693897688
+178778594690563019026094059957945343282346930302669644305902501597239
+986771421554169383555988529148631823791443449673408781187263949647510
+018904134900841706167509366833385055103297208826955076998361636941193
+301521379682583718809183365675122131849284636812555022599830041234478
+486259567449219461702380650591324561082573183538008760862210283427019
+769820231316901767800667519548507992163641937028537512478401490715913
+545998279051339961155179427110683113409058427288427979155484978295432
+353451706522326906139490598769300212296339568778287894844061600741294
+567491982305057164237715481632138063104590291613692670834285644073044
+789997190178146576347322385026725305989979599609079946920177462481771
+844986745565925017832907047311943316555080756822184657174637329688491
+281952031745700244092661691087414838507841192980452298185733897764810
+312608590300130241346718972667321649151113160292078173803343609024380
+4708340403154190336');
print "\nConverting 8192-digit binary number to decimal using Bin2Dec(
+) and Bin2BigInt()\nPlease wait...";
# Generate a 8192-digit binary number:
RunTests('1' . '0' x 8192, '109074813561941592946298424473378286244826
+416199623269243183278618972133184911929521626423452520198722395729179
+615702527310987082017718406361097976507755479907890629884219298953860
+982522804820515969685161359163819677188654260932456012129055390188630
+101790025253579991720001007960002653583680090529780588095235050163019
+547565391100531236456001484742603529355124584392891875276869627934408
+805561751569434994540667782514081490061610592025643850457801332649356
+583604724240738244281224513151775751916489922636574372243227736807502
+762788304520650179276170094569916849725787968385173704999690096112051
+565505011556127149149251534210574896662954703278632150573082843022166
+497032439613863525162640951616800542762343599630892169144618118740639
+531066540488573943483287742816740749537099351186875635997039011702182
+361674945862096985700626361208270671540815706657513728102702231092756
+491027675916052087830463241104936456875492096732298245918476342738379
+027244843801852697776494107271561158043469082745933999196141424274141
+059911742606055648376375631452761136265862838336862115799363802087853
+767554533678991569423443395566631507008721353547025567031200413072549
+583450835743965382893607708097855057891296790735278005493562156109079
+584517295411597292747987752773856000820411855893000477774872776185381
+351049384058186159865221160596030835640594182118971403786872621948149
+872760365361629885617482241303348543878532402475141941718301228107820
+972930353737280457437209522870362277636394529086980625842235514850757
+103961938744962986680818876966281577815307939317909314364834076173858
+181956300299442279075495506128881830843007964869323217915876591803556
+521615711540299212027615560787310793747746684152836298770869945015203
+123186259420308569383894465706134623670423402682110295895495119708707
+654618662279629453645162075650935101890602377382153953277620867697858
+973196633030889330466516943618507835064156833694453005143749131129883
+436726523859540490427345592872394952522718461740436785475461047437701
+976802557660588103807727070771794222197709038543858584409549211609985
+253890397465570394397308609093059696336076752996493841459818570596375
+456149735582781362383328890630900428801732142480866396267133352800923
+275835087305961411872378142210146019861574738685509689608918918044133
+955852482286754111321263879367556765034036297003193002339782846531854
+723824423202801518968966041882297600081543761065225427016359565087543
+385114712321422726660540358178146909080657646895058766199718650566547
+5715792896');
print "\nNow we will convert 5000 random 128-bit binary numbers using
+Bin2BigInt().\nPress ENTER to begin...";
$a = <STDIN>;
my $DEC;
my $TIME = time;
for (my $count = 0; $count < 5000; $count++)
{
my $random = '';
for (my $bits = 0; $bits < 128; $bits++)
{
$random .= (rand(300) > 150) ? '1' : '0';
}
$DEC = Bin2BigInt($random);
print "\n $random => $DEC";
}
print("\n", time - $TIME, ' secs.');
print "\n\nNow we will convert 5000 random 128-bit binary numbers usin
+g Bin2Dec().\nPress ENTER to begin...";
$a = <STDIN>;
$TIME = time;
for (my $count = 0; $count < 5000; $count++)
{
my $random = '';
for (my $bits = 0; $bits < 128; $bits++)
{
$random .= (rand(300) > 150) ? '1' : '0';
}
$DEC = Bin2Dec($random);
print "\n $random => $DEC";
}
print("\n", time - $TIME, ' secs.');
print "\n\n";
exit;
####################################################################
# RUN TESTS:
#
sub RunTests
{
my $i = 0;
my $ERR = 0;
while ($i < @_)
{
my $THIS_OK = 1;
my $BIN = $_[$i++];
my $CORRECT = $_[$i++];
my $DEC1 = Bin2Dec($BIN);
my $DEC2 = Bin2BigInt($BIN);
if ($CORRECT ne $DEC1)
{
print "\nBin2Dec('$BIN') outputs:\n$DEC1 when it should be:\n$CO
+RRECT\n";
$THIS_OK = 0;
$ERR++;
}
if ($CORRECT ne $DEC2)
{
print "\nBin2BigInt('$BIN') outputs:\n$DEC2 when it should be:\n
+$CORRECT\n";
$THIS_OK = 0;
$ERR++;
}
$THIS_OK and print "\nOK $DEC1";
}
print "\n\n $ERR ERRORS.\n\n";
return !$ERR;
}
####################################################################
#
# This function takes a binary number of any size made up of
# 1s and 0s and returns a decimal number (base 10).
#
# This function can convert a 64-bit or 128-bit binary number to
# a decimal number even when 32-bit processor is used. Regardless
# of processor architecture, it will work on any machine.
#
# The input string can contain any number of digits. Any character
# other than 1s and 0s is going to be ignored. The output number
# is going to be a big integer which may contain hundreds or
# even thousands of digits.
#
# Usage: STRING = Bin2Dec(STRING)
#
sub Bin2Dec
{
defined $_[0] or return 0;
my $B = $_[0];
$B =~ tr|01||cd; # Remove illegal chars
$B =~ s/^0+//; # Remove preceding zeros
(my $L = length($B)) or return 0; # Return 0
$L > 32 or return oct('0b' . $B); # Is it 32 bits or less?
my $DEC = oct('0b' . substr($B, -32)); # Convert last 32 bits
$B = substr($B, 0, -32); # Remove last 32 bits
# Convert number up to 49 bits:
$L < 50 and return $DEC + oct('0b' . $B) * 4294967296;
my $i;
my $N;
my $PWR = "\x06\x09\x02\x07\x06\x09\x04\x09\x02\x04"; # 4294967296
$DEC =~ tr|0-9|\x00-\x09|;
$DEC = reverse($DEC);
$L -= 32;
my $PWR2 = 4294967296;
while ($L-- >= 0)
{
if (chop($B)) # Is the next binary digit a '1' ?
{
# Perform simple addition: $DEC += $PWR
$i = (length($PWR) >> 2) + 2;
while ($i-- > 0)
{
vec($DEC, $i, 32) += vec($PWR, $i, 32);
}
# Perform carry operation:
while ($DEC =~ s/([^\x00-\x09])(.)/ $N = ord($1); pack('CC', cho
+p($N), $N + ord($2)) /esg) {}
$DEC =~ s/([^\x00-\x09])$/ $N = ord($1); pack('CC', chop($N), $N
+) /es;
}
# Here we calculate the next power of two.
# We shift each byte of $PWR to the left by 1.
# The fastest way to do this is using the tr/// operator.
# Each digit 0-9 is represented as an ASCII character
# from \0 to \x09 and so once shifted, the numbers then
# become \x00 to \x12. After this, we perform a carry operation.
# Note: $PWR stores numbers backwards, so "4096" would be
# represented as "\x06\x09\x00\x04".
# Multiply each digit by 2:
$PWR =~ tr|\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0C\x0E\x1
+0\x12\x14\x18\x1C\x20\x24\x28\x30\x38\x40\x48\x70|\x00\x02\x04\x06\x0
+8\x0A\x0C\x0E\x10\x12\x14\x18\x1C\x20\x24\x28\x30\x38\x40\x48\x50\x60
+\x70\x80\x90\xE0|;
# Next, we perform the carry operation again:
while ($PWR =~ s/([^\x00-\x09]{1})(.)/ $N = ord($1); pack('CC', ch
+op($N), $N + ord($2)) /esg) {}
$PWR =~ s/([^\x00-\x09]{1})$/ $N = ord($1); pack('CC', chop($N), $
+N) /es;
}
$DEC =~ tr|\x00-\x09|0-9|;
$DEC =~ s/0+$//;
$DEC = reverse($DEC);
return $DEC;
}
####################################################################
#
# This function converts a binary number from base 2 to base 10
# using BIGADD() function which is slower.
# Accepts any number of digits.
#
# Usage: STRING = Bin2BigInt(STRING)
#
sub Bin2BigInt
{
my $N = defined $_[0] ? $_[0] : '';
$N =~ tr|01||cd; # Remove everything except 1s and 0s
$N =~ s/^0+//; # Remove initial zeros
my $L = length($N);
if ($L == 0) { return '0'; }
if ($L <= 32) { return oct('0b' . $N); }
my $OUTPUT = oct('0b' . substr($N, -32));
my $PWR = 4294967296;
$L -= 32;
while ($L--)
{
if (length($PWR) < 15)
{
if (vec($N, $L, 8) == 49) { $OUTPUT += $PWR; }
$PWR += $PWR;
}
else
{
if (vec($N, $L, 8) == 49) { $OUTPUT = BIGADD($OUTPUT, $PWR); }
$PWR = BIGADD($PWR, $PWR);
}
}
return $OUTPUT;
}
####################################################################
#
# This function adds two big positive integers in base 10 and
# returns the sum. There is no error checking done, so make sure
# to only provide digits in the arguments. Any non-digit character
# will mess up the output.
#
# The 1st and 2nd arguments must contain two big integers that have
# to be added. The 3rd and 4th arguments shift these integers to
# the left or right before the addition. For example:
# BIGADD(4, 5, 1, 0) would shift 4 to the right by 1,
# so it would become 40, and then 40 + 5 = 45.
#
# Usage: BIGINT_SUM = BIGADD(BIGINT_A, BIGINT_B, SHIFT_A, SHIFT_B)
#
sub BIGADD
{
no warnings;
my $A = defined $_[0] ? $_[0] : '';
my $B = defined $_[1] ? $_[1] : '';
$A =~ s/^0//g; $A =~ tr|0-9||cd;
$B =~ s/^0//g; $B =~ tr|0-9||cd;
my $AL = length($A) + int($_[2]);
my $BL = length($B) + int($_[3]);
my $P = ($AL > $BL ? $AL : $BL) + 1;
my $CARRY = 0;
my $SUM = '';
while ($P--)
{
my $DIGIT = (($CARRY >> 1) & 1) +
(vec($A, --$AL, 8) & 15) +
(vec($B, --$BL, 8) & 15);
vec($SUM, $P, 8) = $DIGIT + ($CARRY = ($DIGIT > 9) ? 38 : 48);
}
$SUM =~ s/^0+//; # Discard preceding zeros
return (length($SUM)) ? $SUM : 0;
}
This tool would be cool if it worked flawlessly, and I am shamelessly fishing for
help. Rather than Posting in SOPW I'm showing what
I've got here so as not to duplicate the same code in two different parts of the
Monastery.
Windows autoplay will run an application on a USB drive if
set up there, but I don't want to. I want to leave autoplay alone so that it just
harmlessly opens an explorer window when the drive is mounted. I have one drive (the
"Dragon" drive referenced in the code) with a very cool free image program, the
FastStone Image Viewer, portable
edition, installed on it. When I had it plugged into a USB
expansion doohicky I plugged another USB drive
directly into a slot on the computer, and to my shock and amazement Windows "bumped"
the already-inserted drive to a different volume letter! So I said to myself, "I
haven't done any really specific Win32 perl scripting for a while, let me see if I
can write code that will check for a drive with specific characteristics then, in this
case, exec a command from the perl code to fire up the image viewer." Without knowing
the drive letter.
What's really strange is that the code doesn't seem to iterate through the
array @rmvbl unless I use reverse on it! It's the weirdest thing,
I swear this code nearly had me tearing out my hair. Thus all the lines marked "# debugging".
To actually run the code you'll have to adapt it to a drive you have on hand and
check for a characteristic that Win32::DriveInfo::VolumeInfo() can detect; the
vars that receive the retvals of that call are named in a pretty self-explanatory way.
EDIT
I needed a few days to find other ways to mess up and not look at this
code, and it came to me. I was returning undef inside the drive iteration loop instead of
below it, where it needed to be.
One thing to note: the variable $VolumeName will not have
a value for every drive. It's actually a property of the filesystem, not of the entire drive. A
small distinction but important. Anyhow, I think that MS Windows-formatted USB drives won't have this property
(I could be wrong). This drive, I had formatted on Gnu/Linux.
One final mystery remains unsolved, and maybe a reader knows something pertaining. The call
to exec is never supposed to return if successful, according to Perl's documentation,
it is just supposed to completely separate itself from the parent process. When I run this code
from a terminal commandline , however, it hangs around until I close the spawned child. Why?
Here's the final code, corrected:
#!/usr/bin/env perl
# Last modified: Sat Jun 07 2025 01:57:01 PM -04:00 [EDT]
use strict;
use v5.18;
use utf8;
use warnings;
use Win32::DriveInfo;
=head1 NAME
DriveFinder
=head1 SYNOPSIS
To be executed via a desktop shortcut.
Command in shortcut:
C:\perl\perl\bin\perl.exe "C:/Program Files/DriveFinder"
=cut
sub survey {
my @rmvbl = grep { Win32::DriveInfo::DriveType($_) == 2 ?
$_ : undef } Win32::DriveInfo::DrivesInUse();
for my $drv (@rmvbl) {
my ( $VolumeName,
$VolumeSerialNumber,
$MaximumComponentLength,
$FileSystemName, @attr ) =
Win32::DriveInfo::VolumeInfo($drv);
return $drv .":" if $VolumeName eq "FirstFS";
}
return undef;
}
my $DriveVol = &survey;
# Maybe chdir to C:\Users\somia\OneDrive\Pictures? - makes no differen
+ce.
no warnings 'uninitialized';
while ( !exec($DriveVol.'/FS/FSViewer80/FSViewer.exe') )
{
say qq[Plug the USB "Dragon" key drive into a USB slot],q[];
sleep 4;
$DriveVol = &survey;
}
__END__
=pod
=head1 Drive Types on Win32
0 - the drive type cannot be determined.
1 - the root directory does not exist.
2 - the drive can be removed from the drive (removable).
3 - the disk cannot be removed from the drive (fixed).
4 - the drive is a remote (network) drive.
5 - the drive is a CD-ROM drive.
6 - the drive is a RAM disk.
=cut
# vim: ft=perl et sw=4 ts=4 :
A just machine to make big decisions
Programmed by fellows (and gals) with compassion and vision
We'll be clean when their work is done
We'll be eternally free yes, and eternally young Donald Fagen —> I.G.Y. (Slightly modified for inclusiveness)
Many years ago I took this sudoku generator and started writing a Sudoku program using Tk. Every once in a while I'd pull it out and make some changes, add some features, fix some bugs. It has recently reached a fairly feature complete state so I'm posting it here. Some of the features I've added I don't use too often so they may have some bugs yet. Enjoy!
Recently, i've been battling with a few modules made by a former co-worker that are, how should i put it politely, garbage. The modules call a third party web API that could block up to a minute in a cyclic executive that is supposed the have a cycle time of under a second. So he used fork (via the "forks" module), that messes up all kinds of other things (open handles and stuff).
All i needed was a very simple HTTP(s) client that runs a single GET or POST call, non-blocking (except the initial TCP/SSL connect), single-threaded, with just frequent cyclic calls for processing. I couldn't find something that fit my requirements, so i spent a couple of hours writing my own. It's not fully finished and tested yet (haven't tested non-encrypted connection at all), but here it is so you can play with the code:
(Edit: Put the main code in readmore tags because of the length)
It's part of my PageCamel framework. Don't worry about the $self->{reph}->debuglog() calls, that's just the (rather complex) reporting handler i use for my stuff. The relevant function "debuglog" is easy to simulate. Here's the test program:
#/usr/bin/env perl
use v5.40;
use strict;
use warnings;
our $VERSION = 4.6;
# Simulate the PageCamel reporting handler without all the PostgreSQL
+and Net::Clacks stuff
package Reporting;
sub new($proto, %config) {
my $class = ref($proto) || $proto;
my $self = bless \%config, $class;
return $self;
}
sub debuglog($self, @data) {
print join('', @data), "\n";
return;
}
# Test program here
package main;
use Data::Dumper;
use PageCamel::Helpers::AsyncUA;
use Time::HiRes qw(sleep);
use Carp;
my $reph = Reporting->new();
my $ua = PageCamel::Helpers::AsyncUA->new(host => 'cavac.at', use_ssl
+=> 1, ua => 'PageCamel_AsyncUA/' . $VERSION, reph => $reph);
if(1){
# Call the sleeptest with GET, this should return a json after a f
+ew seconds artificial delay
print "############################## GET ########################
+\n";
if(!$ua->get('/guest/sleeptest/asdjkhfashdflkahsdflhasas7d8687asd6
+f')) {
croak("Failed to start request");
}
while(!$ua->finished()) {
print "Do something else...\n";
sleep(0.05);
}
my ($status, $headers, $body) = $ua->result();
print "Return code: $status\n";
#print Dumper($headers);
print Dumper($body);
}
if(1){
# Call the sleeptest with POST, this should return a our post data
+ in reverse ('dlroW olleH') after a few seconds artificial delay
print "############################## POST #######################
+#\n";
if(!$ua->post('/guest/sleeptest/asdjkhfashdflkahsdflhasas7d8687asd
+6f', 'application/octed-stream', 'Hello World')) {
croak("Failed to start request");
}
while(!$ua->finished()) {
print "Do something else...\n";
sleep(0.05);
}
my ($status, $headers, $body) = $ua->result();
print "Return code: $status\n";
#print Dumper($headers);
print Dumper($body);
}
"Perl Tone
The approach described here will set up a new software-defined MIDI device which will proxy events from our hardware, while applying any number of filters to events before they are forwarded. These examples will make use of Perl bindings to RtMidi."
Attacca Quartet:1-8,10-20,22-28
John Patitucci:1-3,5,8,11-17,19,25-28
Roomful of Teeth:1,3,5,7,9,12,14,16,19,21,24,26,28
Sō Percussion:1,3-8,11-16,18-19,21-28
So I thought: Perl must have an easy way to find consecutive numbers inside a regex. And indeed it does!
Here is my script, which was originally a one-liner. It consolidates ranges in text using the (??{code}) construct in the search pattern to find consecutive numbers, and leaves everything intact that doesn't look like a number range.
It passes all the tests I threw at it, as long as the ranges are sane, non-overlapping and sorted in ascending order. I made it so that it can handle pre-existing ranges in the input, since I needed some of that code anyway and now it looks cool and has some nice internal symmetry. It does not merge duplicate ranges, nor does it try to handle whitespace. So it is basically only useful if the input data for this stage is generated by your own code (or your own data manipulations in Vim, as in my case). Definitely don't use it for processing arbitrary user input, there are good modules for that!
#!/usr/bin/perl -wp
1 while s/-(\d+),(??{1+$1})-/-/
or s/-(\d+),((??{1+$1}))\b/-$2/
or s/\b(\d+),(??{1+$1})-/$1-/
or s/\b(\d+),((??{1+$1}))\b/$1-$2/;
This was an interesting learning experience to use the (??{code}) construct! Note that I put capturing parentheses around the (?{...}) items only where it was necessary.
If you want to sort your data before consolidating the ranges, you could first do something like this, but note that this does not ignore extra text:
