diff --git a/CHANGES b/CHANGES index c603fc9..ac1f84d 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,25 @@ This file describes changes in the IO package. +Changes since 4.10.0 + - Pickle free and finitely presented groups, their elements and their + subgroups + - Stop unpickling from evaluating its input: permutations, finite field + elements and cyclotomics used to be stored as their printed form and read + back with EvalString, so a pickle from an untrusted source could run + arbitrary code. They now use formats that need no evaluation, and the old + formats are parsed rather than evaluated. Pickles written by earlier + versions are still readable; pickles written by this version need IO 4.11 + or newer to read + - Unpickle functions stored by name without evaluating anything, and refuse + to evaluate pickled function source unless + IO_UnpickleAllowEvalOfFunctions is set to true + - Pickle rationals, infinity and -infinity directly + - Document `IO_Pickle( ob )` and `IO_Unpickle( str )`, which pickle to and + from a string instead of a file. These have existed since 2011 but were + never documented + - Make `IO_Pickle( ob )` report failure instead of returning a truncated + string, and drop its 1 MB preallocation + 4.10.0 (2026-07-14) - Handle chunked HTTP responses without waiting for the server to close the connection diff --git a/PackageInfo.g b/PackageInfo.g index 57aa975..402c26b 100644 --- a/PackageInfo.g +++ b/PackageInfo.g @@ -7,7 +7,7 @@ SetPackageInfo( rec( PackageName := "IO", Subtitle := "Bindings for low level C library I/O routines", -Version := "4.10.0", +Version := "4.10.0dev", Date := "14/07/2026", # dd/mm/yyyy format License := "GPL-3.0-or-later", diff --git a/doc/main.xml b/doc/main.xml index a7c1963..5c0a2dc 100644 --- a/doc/main.xml +++ b/doc/main.xml @@ -2050,11 +2050,40 @@ to each other and to other objects.

rational functions, lists, records, compressed vectors and matrices over finite fields (objects are uncompressed in the byte stream but recompressed - during unpickling), and straight line programs. + during unpickling), straight line programs, and free and finitely + presented groups together with their elements and subgroups.

Self-referential objects built from records and lists are handled correctly and are restored completely with the same self-references during unpickling. +

+ An element of a free or finitely presented group is only usable + next to the group it came from, so pickling one also pickles that + group. Objects pickled together share the group and can be + combined afterwards, but objects pickled in separate calls + cannot: each call rebuilds a group of its own, and ⪆ keeps + elements of different groups apart even when the presentations + agree. Unpickling never re-uses a group that already exists in the + session either. So pickle a list of elements, not one element at a + time. + + + + + + a string or IO&uscore;Error + + As above, except that the result is returned as a string instead of + being written to a File object. Use this to keep pickled + objects in memory, or to hand them to code that has nowhere to write + a file. If the object cannot be pickled, IO&uscore;Error is + returned. Read the string back with + . + +gap> s := IO_Pickle( [ 1, "two", (3,4) ] );; +gap> IO_Unpickle( s ); +[ 1, "two", (3,4) ] + @@ -2073,6 +2102,30 @@ to each other and to other objects.

+ + + IO&uscore;Error or a ⪆ object + + Unpickles the first object stored in the string str, which + may be immutable and is not changed. Anything in str after + that first object is ignored. + + + + + + + A pickled function is stored as the name of the global variable + holding it where possible, and as its source code otherwise. + Reading the latter back means evaluating it, which lets a pickle + from an untrusted source run arbitrary code, so + refuses to do it and returns + IO&uscore;Error unless this variable is set to + true. It is false by default. Functions stored by + name are unpickled either way. + + + Nothing @@ -2154,6 +2207,29 @@ created object or the value IO&uscore;Error if an error occurred. They should never go into a break loop, because after leaving the user has to call explicitly! +

+The helpers IO&uscore;GenericObjectPickler and +IO&uscore;GenericObjectUnpickler cover the common case of an object +that is rebuilt from a few constituents and then has attributes set on +it. Those constituents, the prepickled objects, are written +before the object itself is added to the pickle cache, since the +object cannot be created without them. One consequence is easy to trip +over: at the top of a stream the cache is empty, so each prepickled +object is written, and the cache discarded, independently of the next. +Two prepickled objects that are the same object in memory are therefore +written twice and come back as two objects when the pickle is the +outermost one, though not when it sits inside a list or record. +

+So a pickler using these helpers must not rely on one prepickled object +referring to another. Store plain data instead and rebuild the +references afterwards, as the picklers for finitely presented groups in +pkg/io/gap/pickle.gi do: they write the external representations +of words rather than the words themselves, and turn them back into +elements of a group the unpickler already holds. Note that this is a +property of the byte format, not just of the implementation — changing +when the cache is cleared would change the meaning of the +self-references in every pickle already written. +

Perhaps the best way to learn how to extend the framework is to study the code for the basic &GAP; objects in the file diff --git a/gap/pickle.gd b/gap/pickle.gd index 6cf13e9..8806b93 100644 --- a/gap/pickle.gd +++ b/gap/pickle.gd @@ -21,8 +21,11 @@ DeclareGlobalFunction( "IO_ReadSmallInt" ); DeclareGlobalFunction( "IO_WriteAttribute" ); DeclareGlobalFunction( "IO_ReadAttribute" ); DeclareGlobalFunction( "IO_PickleByString" ); -DeclareGlobalFunction( "IO_UnpickleByEvalString" ); +DeclareGlobalFunction( "IO_UnpickleByEvalString" ); # deprecated, see below DeclareGlobalFunction( "IO_UnpickleByFunction" ); +DeclareGlobalFunction( "IO_UnpickleByParser" ); +DeclareGlobalFunction( "IO_ParseLegacyExpression" ); +DeclareGlobalFunction( "IO_ParsePermString" ); DeclareGlobalFunction( "IO_GenericObjectPickler" ); DeclareGlobalFunction( "IO_GenericObjectUnpickler" ); @@ -32,14 +35,25 @@ DeclareOperation( "IO_Pickle", [ IsObject ]); DeclareOperation( "IO_Unpickle", [ IsStringRep ]); BindGlobal ("IO_Unpicklers", rec() ); +# Unpickling the source of a function means evaluating it, which lets a +# hostile pickle run arbitrary code, so it is refused unless this is set. +# Functions that are global variables are unpickled by name either way. +IO_UnpickleAllowEvalOfFunctions := false; + # Here is an overview over the defined tags in this package: # # CHAR a character -# CYCL a cyclotomic +# CYCC a cyclotomic, as its coefficients over the rationals # FAIL fail # FALS false -# FFEL a finite field element +# FFEC a finite field element, as its coefficients over the prime field # FLOT a Floating point number +# FPEL an element of a finitely presented group +# FPGR a finitely presented group +# FPSG a subgroup of a free or finitely presented group +# FRAC a rational number +# FREG a free group +# FREW an element of a free group # FUNC a GAP function, if it is a global one, only its name is pickled # GAPL a gap in a list (unbound entries) # GSLP a GAP straight line program @@ -60,11 +74,13 @@ BindGlobal ("IO_Unpicklers", rec() ); # MREC a mutable record # MRNG a mutable range # MSTR a mutable string +# NINF minus infinity # OPER a GAP operation, only its name is pickled -# PERM a permutation -# PPER a partial permutation +# PINF infinity # POLF an object in the representation IsPolynomialDefaultRep # POLY a Laurent polynomial (or a rational function) deprecated +# PPER a partial permutation +# PRML a permutation, as its list of images # RATF an object in the representation IsRationalFunctionDefaultRep # RSGL the global random source # RSGA a GAP random source @@ -76,6 +92,15 @@ BindGlobal ("IO_Unpicklers", rec() ); # UPOL an object in the representation IsLaurentPolynomialDefaultRep # URFU an object in the representation IsUnivariateRationalFunctionDefaultRep # +# These tags are only read, never written. They store the printed form of the +# object, which used to be read back with EvalString; that let a hostile +# pickle run arbitrary code, so they are parsed now and were replaced by the +# tags above. Files written before IO 4.11 still use them. +# +# CYCL a cyclotomic +# FFEL a finite field element +# PERM a permutation +# # Some tags defined in other packages: # # ICVC an immutable cvec diff --git a/gap/pickle.gi b/gap/pickle.gi index 69a756f..fc34aff 100644 --- a/gap/pickle.gi +++ b/gap/pickle.gi @@ -148,15 +148,254 @@ InstallGlobalFunction( IO_UnpickleByFunction, len := IO_ReadSmallInt(f); if len = IO_Error then return IO_Error; fi; s := IO_ReadBlock(f,len); - if s = fail then return IO_Error; fi; + if s = fail or Length(s) < len then return IO_Error; fi; return unpickleFn(s); end; end ); +# Deprecated: this evaluates its input, so a hostile pickle can run arbitrary +# code. Kept only because it is a documented global. Use a parser instead. InstallGlobalFunction( IO_UnpickleByEvalString, IO_UnpickleByFunction(EvalString) ); +############################################################################# +## +## Readers for the deprecated PERM, FFEL and CYCL formats. +## +## These store the printed form of the object and used to be read back with +## EvalString, which let a hostile pickle run arbitrary code (issue #7). They +## are parsed instead. New pickles use PRML, FFEC and CYCC. +## + +# The only functions a deprecated pickle may name. The bounds stop a hostile +# pickle from asking for an object large enough to exhaust memory; they are +# far above anything GAP ever printed. +BindGlobal( "IO_LegacyFuncs", rec( + E := rec( + check := a -> Length(a) = 1 and a[1] >= 1 and a[1] <= 2^24, + call := a -> E(a[1]) ), + Z := rec( + check := a -> (Length(a) = 1 and a[1] <= 2^48 and IsPrimePowerInt(a[1])) + or (Length(a) = 2 and a[1] <= 2^48 and IsPrimeInt(a[1]) + and a[2] >= 1 and a[2] <= 2^16), + call := a -> CallFuncList(Z,a) ), + ZmodnZObj := rec( + check := a -> Length(a) = 2 and a[2] >= 1 and a[2] <= 2^48, + call := a -> ZmodnZObj(a[1],a[2]) ), + ZmodpZObj := rec( + check := a -> Length(a) = 2 and a[2] <= 2^48 and IsPrimeInt(a[2]), + call := a -> ZmodpZObj(a[1],a[2]) ), +) ); + +# Finite field elements and cyclotomics live in disjoint modes so that no +# expression can mix them; together with the guards below this makes every +# operation total, so nothing in here can throw. +BindGlobal( "IO_LegacyFFEMode", rec( + funcs := [ "Z", "ZmodnZObj", "ZmodpZObj" ], + allowdiv := false, + ok := v -> IsInt(v) or IsFFE(v), + final := IsFFE ) ); + +BindGlobal( "IO_LegacyCycMode", rec( + funcs := [ "E" ], + allowdiv := true, + ok := IsCyclotomic, + final := IsCyclotomic ) ); + +InstallGlobalFunction( IO_ParseLegacyExpression, + function( s, mode ) + local len, pos, skip, integer, combine, atom, factor, term, expr, res; + + len := Length(s); + pos := 1; + + skip := function() + while pos <= len and s[pos] = ' ' do pos := pos + 1; od; + end; + + integer := function() + local start; + start := pos; + while pos <= len and IsDigitChar(s[pos]) do pos := pos + 1; od; + if pos = start then return fail; fi; + return Int(s{[start..pos-1]}); + end; + + combine := function( op, a, b ) + if IsFFE(a) and IsFFE(b) and Characteristic(a) <> Characteristic(b) then + return fail; + fi; + if op = '+' then return a + b; + elif op = '-' then return a - b; + elif op = '*' then return a * b; + elif IsZero(b) then return fail; + else return a / b; fi; + end; + + atom := function() + local start, name, entry, args, a; + skip(); + if pos > len then return fail; fi; + if s[pos] = '(' then + pos := pos + 1; + a := expr(); + if a = fail then return fail; fi; + skip(); + if pos > len or s[pos] <> ')' then return fail; fi; + pos := pos + 1; + return a; + fi; + if IsDigitChar(s[pos]) then return integer(); fi; + start := pos; + while pos <= len and IsAlphaChar(s[pos]) do pos := pos + 1; od; + name := s{[start..pos-1]}; + if not name in mode.funcs then return fail; fi; + entry := IO_LegacyFuncs.(name); + skip(); + if pos > len or s[pos] <> '(' then return fail; fi; + pos := pos + 1; + args := []; + skip(); + if pos <= len and s[pos] = ')' then + pos := pos + 1; + else + while true do + a := expr(); + if not IsInt(a) or a < 0 then return fail; fi; + Add(args,a); + skip(); + if pos > len then return fail; fi; + if s[pos] = ')' then pos := pos + 1; break; fi; + if s[pos] <> ',' then return fail; fi; + pos := pos + 1; + od; + fi; + if not entry.check(args) then return fail; fi; + return entry.call(args); + end; + + factor := function() + local neg, base, e; + skip(); + neg := false; + while pos <= len and (s[pos] = '-' or s[pos] = '+') do + if s[pos] = '-' then neg := not neg; fi; + pos := pos + 1; + skip(); + od; + base := atom(); + if base = fail or not mode.ok(base) then return fail; fi; + skip(); + if pos <= len and s[pos] = '^' then + pos := pos + 1; + e := factor(); + if e = fail or not IsInt(e) then return fail; fi; + if e < 0 and IsZero(base) then return fail; fi; + # a rational base with a large exponent is a memory bomb, and no + # printed GAP object needs one + if IsRat(base) and AbsInt(e) > 1024 then return fail; fi; + base := base ^ e; + fi; + if neg then base := - base; fi; + return base; + end; + + term := function() + local res, op, rhs; + res := factor(); + if res = fail then return fail; fi; + while true do + skip(); + if pos > len then return res; fi; + op := s[pos]; + if op <> '*' and op <> '/' then return res; fi; + if op = '/' and not mode.allowdiv then return res; fi; + pos := pos + 1; + rhs := factor(); + if rhs = fail then return fail; fi; + res := combine(op,res,rhs); + if res = fail or not mode.ok(res) then return fail; fi; + od; + end; + + expr := function() + local res, op, rhs; + res := term(); + if res = fail then return fail; fi; + while true do + skip(); + if pos > len then return res; fi; + op := s[pos]; + if op <> '+' and op <> '-' then return res; fi; + pos := pos + 1; + rhs := term(); + if rhs = fail then return fail; fi; + res := combine(op,res,rhs); + if res = fail or not mode.ok(res) then return fail; fi; + od; + end; + + res := expr(); + if res = fail then return fail; fi; + skip(); + if pos <= len or not mode.final(res) then return fail; fi; + return res; + end ); + +InstallGlobalFunction( IO_ParsePermString, + function( s ) + local imgs, len, pos, cyc, start, n, i; + imgs := []; + len := Length(s); + pos := 1; + while pos <= len do + if s[pos] <> '(' then return fail; fi; + pos := pos + 1; + cyc := []; + while pos <= len and s[pos] <> ')' do + if not IsEmpty(cyc) then + if s[pos] <> ',' then return fail; fi; + pos := pos + 1; + fi; + start := pos; + while pos <= len and IsDigitChar(s[pos]) do pos := pos + 1; od; + if pos = start then return fail; fi; + n := Int(s{[start..pos-1]}); + # MAX_DEG_PERM4 is 2^28-1; anything beyond is not a permutation + if n < 1 or n >= 2^28 or IsBound(imgs[n]) then return fail; fi; + imgs[n] := n; + Add(cyc,n); + od; + if pos > len then return fail; fi; # unterminated cycle + pos := pos + 1; + for i in [1..Length(cyc)] do + imgs[cyc[i]] := cyc[(i mod Length(cyc)) + 1]; + od; + od; + for i in [1..Length(imgs)] do + if not IsBound(imgs[i]) then imgs[i] := i; fi; + od; + return PermList(imgs); + end ); + +InstallGlobalFunction( IO_UnpickleByParser, + function( parse ) + return function( f ) + local len, s, res; + len := IO_ReadSmallInt(f); + if len = IO_Error then return IO_Error; fi; + s := IO_ReadBlock(f,len); + if s = fail or Length(s) < len then return IO_Error; fi; + res := parse(s); + if res = fail then + Info(InfoWarning, 1, "IO_Unpickle: malformed pickle \"",s,"\""); + return IO_Error; + fi; + return res; + end; + end ); + InstallGlobalFunction( IO_GenericObjectPickler, function( f, tag, prepickle, ob, atts, filts, comps ) local at,com,fil,nr,o; @@ -281,11 +520,12 @@ InstallMethod( IO_Unpickle, "for a file", InstallMethod(IO_Pickle, "for an object, pickle to string method", [IsObject], function(o) - local f,s; - s := EmptyString(1000000); + local f,res,s; + s := ""; f := IO_WrapFD(-1,false,s); - IO_Pickle(f,o); + res := IO_Pickle(f,o); IO_Close(f); + if res = IO_Error then return IO_Error; fi; ShrinkAllocationString(s); return s; end); @@ -380,10 +620,21 @@ IO_Unpicklers.SPRF := InstallMethod( IO_Pickle, "for a permutation", [ IsFile, IsPerm ], function( f, p ) - return IO_PickleByString( f, p, "PERM" ); + if IO_Write(f,"PRML") = fail then return IO_Error; fi; + return IO_Pickle(f,ListPerm(p)); end ); -IO_Unpicklers.PERM := IO_UnpickleByEvalString; +IO_Unpicklers.PRML := + function( f ) + local l,p; + l := IO_Unpickle(f); if l = IO_Error then return IO_Error; fi; + if not IsList(l) then return IO_Error; fi; + p := PermList(l); + if p = fail then return IO_Error; fi; + return p; + end; + +IO_Unpicklers.PERM := IO_UnpickleByParser( IO_ParsePermString ); InstallMethod( IO_Pickle, "for a transformation", [ IsFile, IsTransformation ], @@ -458,18 +709,94 @@ IO_Unpicklers.CHAR := InstallMethod( IO_Pickle, "for a finite field element", [ IsFile, IsFFE ], function( f, ffe ) - return IO_PickleByString( f, ffe, "FFEL" ); + local d,p; + p := Characteristic(ffe); + d := DegreeFFE(ffe); + if IO_Write(f,"FFEC") = fail then return IO_Error; fi; + if IO_Pickle(f,p) = IO_Error then return IO_Error; fi; + if IO_Pickle(f,d) = IO_Error then return IO_Error; fi; + return IO_Pickle(f,IntVecFFE(Coefficients(CanonicalBasis(GF(p,d)),ffe))); + end ); + +IO_Unpicklers.FFEC := + function( f ) + local c,d,p,z; + p := IO_Unpickle(f); if p = IO_Error then return IO_Error; fi; + d := IO_Unpickle(f); if d = IO_Error then return IO_Error; fi; + c := IO_Unpickle(f); if c = IO_Error then return IO_Error; fi; + # requiring one coefficient per degree bounds the field by the file size + if not (IsInt(p) and IsPosInt(d) and IsList(c) and Length(c) = d and + IsPrimeInt(p) and ForAll(c,IsInt)) then + return IO_Error; + fi; + z := Z(p,d); + return ValuePol(c*(z^0),z); + end; + +IO_Unpicklers.FFEL := IO_UnpickleByParser( + s -> IO_ParseLegacyExpression(s,IO_LegacyFFEMode) ); + +# Rationals need a method of their own: they are cyclotomics, so without one +# the coefficients written below would pickle themselves forever. Integers are +# unaffected, the IsInt method above is more specific still. +InstallMethod( IO_Pickle, "for a rational", + [ IsFile, IsRat ], + function( f, x ) + if IO_Write(f,"FRAC") = fail then return IO_Error; fi; + if IO_Pickle(f,NumeratorRat(x)) = IO_Error then return IO_Error; fi; + return IO_Pickle(f,DenominatorRat(x)); end ); -IO_Unpicklers.FFEL := IO_UnpickleByEvalString; +IO_Unpicklers.FRAC := + function( f ) + local d,n; + n := IO_Unpickle(f); if n = IO_Error then return IO_Error; fi; + d := IO_Unpickle(f); if d = IO_Error then return IO_Error; fi; + if not (IsInt(n) and IsPosInt(d)) then return IO_Error; fi; + return n/d; + end; InstallMethod( IO_Pickle, "for a cyclotomic", [ IsFile, IsCyclotomic ], function( f, cyc ) - return IO_PickleByString( f, cyc, "CYCL" ); + local n; + n := Conductor(cyc); + if IO_Write(f,"CYCC") = fail then return IO_Error; fi; + if IO_Pickle(f,n) = IO_Error then return IO_Error; fi; + return IO_Pickle(f,CoeffsCyc(cyc,n)); + end ); + +IO_Unpicklers.CYCC := + function( f ) + local c,n; + n := IO_Unpickle(f); if n = IO_Error then return IO_Error; fi; + c := IO_Unpickle(f); if c = IO_Error then return IO_Error; fi; + # one coefficient per root of unity bounds the conductor by the file size + if not (IsPosInt(n) and IsList(c) and Length(c) = n and ForAll(c,IsRat)) + then return IO_Error; fi; + return CycList(c); + end; + +IO_Unpicklers.CYCL := IO_UnpickleByParser( + s -> IO_ParseLegacyExpression(s,IO_LegacyCycMode) ); + +InstallMethod( IO_Pickle, "for infinity", + [ IsFile, IsInfinity ], + function( f, x ) + if IO_Write(f,"PINF") = fail then return IO_Error; fi; + return IO_OK; end ); -IO_Unpicklers.CYCL := IO_UnpickleByEvalString; +IO_Unpicklers.PINF := infinity; + +InstallMethod( IO_Pickle, "for negative infinity", + [ IsFile, IsNegInfinity ], + function( f, x ) + if IO_Write(f,"NINF") = fail then return IO_Error; fi; + return IO_OK; + end ); + +IO_Unpicklers.NINF := -infinity; InstallMethod( IO_Pickle, "for a list", [ IsFile, IsList ], @@ -1020,14 +1347,11 @@ InstallMethod( IO_Pickle, "for an operation", IO_FuncToUnpickle := fail; IO_Unpicklers.OPER := function( f ) - local i,s; + local s; s := IO_Unpickle(f); if s = IO_Error then return IO_Error; fi; - s := Concatenation( "IO_FuncToUnpickle := ",s,";" ); - i := InputTextString(s); - Read(i); - if not(IsBound(IO_FuncToUnpickle)) then return IO_Error; fi; - s := IO_FuncToUnpickle; - Unbind(IO_FuncToUnpickle); + if not (IsString(s) and IsBoundGlobal(s)) then return IO_Error; fi; + s := ValueGlobal(s); + if not IsOperation(s) then return IO_Error; fi; return s; end; @@ -1055,6 +1379,20 @@ IO_Unpicklers.FUNC := function( f ) local i,s; s := IO_Unpickle(f); if s = IO_Error then return IO_Error; fi; + if not IsString(s) then return IO_Error; fi; + # the pickler writes a global's name where it can, and the function's + # source otherwise; only the latter needs evaluating + if IsBoundGlobal(s) then + s := ValueGlobal(s); + if not IsFunction(s) then return IO_Error; fi; + return s; + fi; + if not IO_UnpickleAllowEvalOfFunctions then + Info(InfoWarning, 1, "IO_Unpickle: refusing to evaluate the source of ", + "a pickled function; set IO_UnpickleAllowEvalOfFunctions := true ", + "if you trust this data"); + return IO_Error; + fi; s := Concatenation( "IO_FuncToUnpickle := ",s,";" ); i := InputTextString(s); Read(i); @@ -1313,6 +1651,180 @@ IO_Unpicklers.CTBL:= function( f ) return tbl; end; +############################################################################# +## +## Free and finitely presented groups. +## +## An element only makes sense next to the group it came from: two elements +## unpickled against two different reconstructions of the same presentation +## land in different GAP families and cannot be multiplied. So an element +## pickles a reference to its group, which the pickle cache then emits once +## per stream -- everything pickled together shares one family. Objects +## pickled in *separate* streams cannot be combined; that is inherent. +## +## Words are always stored as their external representation rather than as +## objects, and rebuilt against a group the reader already holds. Relying on +## the pickle cache instead would break: it is discarded between the objects +## IO_GenericObjectPickler writes before registering its own, so at the top +## of a stream each word would carry -- and unpickle to -- a free group of +## its own. +## + +# The group an element belongs to. GAP stores this on the collections family +# of the elements family, both for free groups (lib/grpfree.gi) and for +# finitely presented ones (lib/grpfp.gi). +BindGlobal( "IO_WholeGroupOfElement", + function( x ) + local fam; + fam := CollectionsFamily(FamilyObj(x)); + if not IsBound(fam!.wholeGroup) then return fail; fi; + return fam!.wholeGroup; + end ); + +# The free group underlying , which for a free group is itself +BindGlobal( "IO_FreeGroupUnderlying", + function( g ) + local fam; + fam := ElementsFamily(FamilyObj(g)); + if not IsBound(fam!.freeGroup) then return fail; fi; + return fam!.freeGroup; + end ); + +BindGlobal( "IO_ExtRepOfFpWord", + function( x ) + if IsElementOfFpGroup(x) then return ExtRepOfObj(UnderlyingElement(x)); fi; + return ExtRepOfObj(x); + end ); + +BindGlobal( "IO_IsExtRepOfWord", + function( ext, rank ) + local i; + if not IsList(ext) or IsOddInt(Length(ext)) then return false; fi; + for i in [1..Length(ext)/2] do + if not IsBound(ext[2*i-1]) or not IsBound(ext[2*i]) then return false; fi; + if not (IsPosInt(ext[2*i-1]) and ext[2*i-1] <= rank) then return false; fi; + if not (IsInt(ext[2*i]) and ext[2*i] <> 0) then return false; fi; + od; + return true; + end ); + +# Turn external representations back into elements of , or fail +BindGlobal( "IO_FpWordsByExtRep", + function( g, exts ) + local free, fam, rank; + free := IO_FreeGroupUnderlying(g); + if free = fail or not IsList(exts) then return fail; fi; + rank := Length(GeneratorsOfGroup(free)); + if not ForAll(exts, e -> IO_IsExtRepOfWord(e,rank)) then return fail; fi; + fam := ElementsFamily(FamilyObj(free)); + exts := List(exts, e -> ObjByExtRep(fam,e)); + if IsFreeGroup(g) then return exts; fi; + fam := ElementsFamily(FamilyObj(g)); + return List(exts, w -> ElementOfFpGroup(fam,w)); + end ); + +# One method for all of them: a free group also satisfies IsFpGroup, so +# relying on filter ranking between competing methods would be fragile. +InstallMethod( IO_Pickle, "for a free or finitely presented group", + [ IsFile, IsSubgroupFpGroup ], + function( f, g ) + if HasIsWholeFamily(g) and IsWholeFamily(g) then + if IsFreeGroup(g) then + if not IsFinitelyGeneratedGroup(g) then + Info(InfoWarning, 1, + "IO_Pickle: cannot pickle a free group of infinite rank"); + return IO_Error; + fi; + return IO_GenericObjectPickler(f,"FREG", + [ElementsFamily(FamilyObj(g))!.names],g,[Name],[],[]); + fi; + return IO_GenericObjectPickler(f,"FPGR", + [IO_FreeGroupUnderlying(g), + List(RelatorsOfFpGroup(g),ExtRepOfObj)],g, + [Name,Size],[],[]); + fi; + return IO_GenericObjectPickler(f,"FPSG", + [FamilyObj(g)!.wholeGroup, + List(GeneratorsOfGroup(g),IO_ExtRepOfFpWord)],g, + [Name,Size],[],[]); + end ); + +IO_Unpicklers.FREG := + function( f ) + local names; + names := IO_Unpickle(f); if names = IO_Error then return IO_Error; fi; + if not (IsList(names) and ForAll(names,IsString)) then return IO_Error; fi; + return IO_GenericObjectUnpickler(f,FreeGroup(names),[Name],[]); + end; + +IO_Unpicklers.FPGR := + function( f ) + local free,rels; + free := IO_Unpickle(f); if free = IO_Error then return IO_Error; fi; + rels := IO_Unpickle(f); if rels = IO_Error then return IO_Error; fi; + if not IsFreeGroup(free) then return IO_Error; fi; + rels := IO_FpWordsByExtRep(free,rels); + if rels = fail then return IO_Error; fi; + return IO_GenericObjectUnpickler(f,free/rels,[Name,Size],[]); + end; + +IO_Unpicklers.FPSG := + function( f ) + local gens,whole; + whole := IO_Unpickle(f); if whole = IO_Error then return IO_Error; fi; + gens := IO_Unpickle(f); if gens = IO_Error then return IO_Error; fi; + if not IsSubgroupFpGroup(whole) then return IO_Error; fi; + gens := IO_FpWordsByExtRep(whole,gens); + if gens = fail then return IO_Error; fi; + return IO_GenericObjectUnpickler(f,SubgroupNC(whole,gens), + [Name,Size],[]); + end; + +# IsAssocWordWithInverse also covers words that are not from a free group +InstallMethod( IO_Pickle, "for an element of a free group", + [ IsFile, IsAssocWordWithInverse ], + function( f, w ) + local free; + free := IO_WholeGroupOfElement(w); + if free = fail or not IsFreeGroup(free) then TryNextMethod(); fi; + if IO_Write(f,"FREW") = fail then return IO_Error; fi; + if IO_Pickle(f,free) = IO_Error then return IO_Error; fi; + return IO_Pickle(f,ExtRepOfObj(w)); + end ); + +IO_Unpicklers.FREW := + function( f ) + local ext,free; + free := IO_Unpickle(f); if free = IO_Error then return IO_Error; fi; + ext := IO_Unpickle(f); if ext = IO_Error then return IO_Error; fi; + if not IsFreeGroup(free) then return IO_Error; fi; + ext := IO_FpWordsByExtRep(free,[ext]); + if ext = fail then return IO_Error; fi; + return ext[1]; + end; + +InstallMethod( IO_Pickle, "for an element of a finitely presented group", + [ IsFile, IsElementOfFpGroup ], + function( f, x ) + local g; + g := IO_WholeGroupOfElement(x); + if g = fail then return IO_Error; fi; + if IO_Write(f,"FPEL") = fail then return IO_Error; fi; + if IO_Pickle(f,g) = IO_Error then return IO_Error; fi; + return IO_Pickle(f,ExtRepOfObj(UnderlyingElement(x))); + end ); + +IO_Unpicklers.FPEL := + function( f ) + local ext,g; + g := IO_Unpickle(f); if g = IO_Error then return IO_Error; fi; + ext := IO_Unpickle(f); if ext = IO_Error then return IO_Error; fi; + if not IsSubgroupFpGroup(g) then return IO_Error; fi; + ext := IO_FpWordsByExtRep(g,[ext]); + if ext = fail then return IO_Error; fi; + return ext[1]; + end; + ## ## This program is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by diff --git a/tst/pickle.g b/tst/pickle.g index 8101799..42aeab2 100644 --- a/tst/pickle.g +++ b/tst/pickle.g @@ -299,3 +299,170 @@ if List(floatlist, x -> ExtRepOfObj(x)) <> List(unpickled_floatlist, x -> ExtRepOfObj(x)) then Error(46); fi; + +# Deprecated formats: pickles written before IO 4.11 store the printed form of +# permutations, finite field elements and cyclotomics. Those are parsed rather +# than evaluated now, so check the parsers against everything GAP prints. + +pickle_as := function( ob, tag ) + local s, f, res; + s := ""; f := IO_WrapFD(-1,false,s); + IO_PickleByString(f,ob,tag); + IO_Close(f); + f := IO_WrapFD(-1,s,false); res := IO_Unpickle(f); IO_Close(f); + return res; +end;; + +for x in [ (), (1,2), (1,2,3)(5,7), (2,3)(4,10000), + Random(SymmetricGroup(500)) ] do + if pickle_as(x,"PERM") <> x then + Error( 47 ); + fi; +od; + +old:=InfoLevel(InfoWarning);; +SetInfoLevel(InfoWarning, 0);; +for x in [ Z(2), 0*Z(2), Z(5)^2, Z(4), Z(9)^5, Z(65537)^3, Z(65537^2)^5, + Z(2,20)^123, Z(3,20)^7, Z(2,100)^3+Z(2,100)^5, Z(65537,2)^7 ] do + if pickle_as(x,"FFEL") <> x then + Error( 48 ); + fi; +od; +SetInfoLevel(InfoWarning, old);; + +for x in [ E(3), E(4), -5, 7/3, -22/7, 3/7*E(15)-5*E(15)^2+11/13 ] do + if pickle_as(x,"CYCL") <> x then + Error( 49 ); + fi; +od; + +# ... and reject anything else rather than executing it + +pickle_raw := function( str, tag ) + local s, f, res; + s := ""; f := IO_WrapFD(-1,false,s); + IO_Write(f,tag); IO_WriteSmallInt(f,Length(str)); IO_Write(f,str); + IO_Close(f); + f := IO_WrapFD(-1,s,false); res := IO_Unpickle(f); IO_Close(f); + return res; +end;; + +IO_TestWasPwned := false;; +SetInfoLevel(InfoWarning, 0);; +for x in [ [ "IO_TestWasPwned := true;", "PERM" ], + [ "IO_TestWasPwned := true", "FFEL" ], + [ "IO_TestWasPwned := true", "CYCL" ], + [ "Exec(\"true\")", "CYCL" ], + [ "E(2^64)", "CYCL" ], # memory bomb + [ "2^(2^64)", "CYCL" ], + [ "Z(2)+E(3)", "FFEL" ], # mixing domains + [ "1/0", "CYCL" ], + [ "((((", "PERM" ], + [ "(1,2", "PERM" ] ] do + if pickle_raw(x[1],x[2]) <> IO_Error then + Error( 50 ); + fi; +od; +SetInfoLevel(InfoWarning, old);; +if IO_TestWasPwned <> false then + Error( 51 ); +fi; + +# Pickled function source is evaluated only on request + +pickled_func := IO_Pickle(function(x) return x+1; end);; +SetInfoLevel(InfoWarning, 0);; +if IO_Unpickle(pickled_func) <> IO_Error then + Error( 52 ); +fi; +SetInfoLevel(InfoWarning, old);; +IO_UnpickleAllowEvalOfFunctions := true;; +if IO_Unpickle(pickled_func)(1) <> 2 then + Error( 53 ); +fi; +IO_UnpickleAllowEvalOfFunctions := false;; +# operations named by an operator, whose names are not identifiers +for x in [ Size, IsPrimeInt, \+, \*, \=, \[\], \in, PrintObj ] do + if IO_Unpickle(IO_Pickle(x)) <> x then + Error( 54 ); + fi; +od; + +# Free and finitely presented groups. An element is only usable next to the +# group it came from, so what matters is that objects pickled together still +# fit together afterwards. + +fam_free := FreeGroup("a","b");; +unpickle_free := IO_Unpickle(IO_Pickle(fam_free));; +if not IsFreeGroup(unpickle_free) or + List(GeneratorsOfGroup(unpickle_free),String) <> [ "a", "b" ] then + Error( 55 ); +fi; + +fam_words := IO_Unpickle(IO_Pickle([ fam_free.1^3*fam_free.2^-2, + fam_free.2*fam_free.1 ]));; +if List(fam_words,String) <> [ "a^3*b^-2", "b*a" ] then + Error( 56 ); +elif not IsIdenticalObj(FamilyObj(fam_words[1]),FamilyObj(fam_words[2])) then + Error( 57 ); +elif String(fam_words[1]*fam_words[2]) + <> String(fam_free.1^3*fam_free.2^-2*fam_free.2*fam_free.1) then + Error( 58 ); +fi; + +# one copy of the free group per stream, not one per word +if PositionSublist(IO_Pickle(GeneratorsOfGroup(fam_free)),"FREG", + PositionSublist(IO_Pickle(GeneratorsOfGroup(fam_free)),"FREG")) <> fail + then + Error( 59 ); +fi; + +fam_fp := fam_free / [ fam_free.1^2, fam_free.2^3, + (fam_free.1*fam_free.2)^5 ];; +unpickle_fp := IO_Unpickle(IO_Pickle(fam_fp));; +if Size(unpickle_fp) <> 60 then + Error( 60 ); +elif List(RelatorsOfFpGroup(unpickle_fp),String) + <> List(RelatorsOfFpGroup(fam_fp),String) then + Error( 61 ); +fi; + +fam_elms := IO_Unpickle(IO_Pickle([ fam_fp.1*fam_fp.2, fam_fp.2^-1 ]));; +if not IsIdenticalObj(FamilyObj(fam_elms[1]),FamilyObj(fam_elms[2])) then + Error( 62 ); +elif Order(fam_elms[1]*fam_elms[2]) <> Order(fam_fp.1) then + Error( 63 ); +fi; + +fam_sub := Subgroup(fam_fp,[fam_fp.1]);; +unpickle_sub := IO_Unpickle(IO_Pickle(fam_sub));; +if Index(Parent(unpickle_sub),unpickle_sub) <> Index(fam_fp,fam_sub) then + Error( 64 ); +elif Length(GeneratorsOfGroup(IO_Unpickle(IO_Pickle( + Subgroup(fam_free,[fam_free.1^2,fam_free.2]))))) <> 2 then + Error( 65 ); +fi; + +# Rationals, infinity and the new permutation, field element and cyclotomic +# formats round trip + +for x in [ (1,2,3)(5,7), (), Z(4), 0*Z(2), Z(2,100)^3+Z(2,100)^5, + Z(65537)^3, 7/3, -22/7, E(3), 3/7*E(15)-5*E(15)^2+11/13, + 2^100, infinity, -infinity ] do + if IO_Unpickle(IO_Pickle(x)) <> x then + Error( 66 ); + fi; +od; + +# A pickle written by GAP 4.17 / IO 4.11 on 2026-08-16, so that the formats +# introduced there keep being readable. + +pickled_new := "MLIS\>6PRMLMLIS\>7INTG\>12INTG\>13INTG\>11INTG\>14INTG\>17INTG\>16INTG\ +\>15FFECINTG\>12INTG\>12MLIS\>2INTG\>10INTG\>11FRACINTG\>17INTG\>13CYC\ +CINTG\>13MLIS\>3INTG\>10INTG\>11INTG\>10PINFNINF";; + +unpickled_new := IO_Unpickle(pickled_new);; + +if unpickled_new <> [ (1,2,3)(5,7), Z(4), 7/3, E(3), infinity, -infinity ] then + Error( 67 ); +fi;