#!/usr/bin/perl # # PBCDEDIT - Copyright 2019 Marc A. Lehmann # # SPDX-License-Identifier: GPL-3.0-or-later # # 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 # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # use 5.016; # numerous features need 5.14, __SUB__ needs 5.16 our $VERSION = '1.5'; our $JSON_VERSION = 3; # the version of the json objects generated by this program our $CHANGELOG = <,element,path' \ set '{default}' osdevice 'locate=,element,path' =head1 DESCRIPTION This program allows you to create, read and modify Boot Configuration Data (BCD) stores used by Windows Vista and newer versions of Windows. At this point, it is in relatively early stages of development and has received little to no real-world testing. Compared to other BCD editing programs it offers the following unique features: =over =item Can create BCD hives from scratch Practically all other BCD editing programs force you to copy existing BCD stores, which might or might not be copyrighted by Microsoft. =item Does not rely on Windows As the "portable" in the name implies, this program does not rely on C or other windows programs or libraries, it works on any system that supports at least perl version 5.16. =item Decodes and encodes BCD device elements PBCDEDIT can concisely decode and encode BCD device element contents. This is pretty unique, and offers a lot of potential that can't be realised with C or any programs relying on it. =item Minimal files BCD files written by PBCDEDIT are always "minimal", that is, they don't contain unused data areas and therefore don't contain old and potentially sensitive data. =back The target audience for this program is professionals and tinkerers who are ready to invest time into learning how it works. It is not an easy program to use and requires patience and a good understanding of BCD stores. =head1 SUBCOMMANDS PBCDEDIT expects a subcommand as first argument that tells it what to do. The following subcommands exist: =over =item C Displays the whole manual page (this document). =item C This outputs the PBCDEDIT version, the JSON schema version it uses and the full log of changes. =item C F Reads a BCD data store and writes a JSON representation of it to standard output. The format of the data is explained later in this document. Example: read a BCD store, modify it with an external program, write it again. pbcdedit export BCD | modify-json-somehow | pbcdedit import BCD =item C F The reverse of C: Reads a JSON representation of a BCD data store from standard input, and creates or replaces the given BCD data store. =item C F I Load a BCD data store, apply some instructions to it, and save it again. See the section L, below, for more info. =item C F I Same as C, above, except it doesn't save the data store again. Can be useful to extract some data from it. =item C F I Same as C, above, except it creates a new data store from scratch if needed. An existing store will be emptied completely. =item C [C<--json>] On a GNU/Linux system, you can get a list of partition device descriptors using this command - the external C command is required, as well as a mounted C file system. The output will be a list of all partitions in the system and C descriptors for GPT and both C and C descriptors for MBR partitions. With C<--json> it will print similar information as C, but with extra C and C attributes. =item C F Tries to find the BCD device element for the given device, which currently must be a a partition of some kind. Prints the C descriptor as a result, or nothing. Exit status will be true on success, and false on failure. Like C, above, this likely only works on GNU/Linux systems. Example: print the partition descriptor of tghe partition with label DATA. $ pbcdedit bcd-device /dev/disk/by-label/DATA partition=,harddisk,mbr,47cbc08a,213579202560 =item C F Like above, but uses a C descriptor instead. =item C [C<--json>] Outputs two tables: a table listing all type aliases with their hex BCD element ID, and all object name aliases with their GUID and default type (if any). With C<--json> it prints similar information as a JSON object, for easier parsing. =item C [C<--json>] Outputs a table of known element aliases with their hex ID and the format type. With C<--json> it prints similar information as a JSON object, for easier parsing. =item C F This has nothing to do with BCD stores, but simply exposes PCBEDIT's internal registry hive reader - it takes a registry hive file as argument and outputs a JSON representation of it to standard output. Hive versions 1.2 till 1.6 are supported. =item C F The reverse of C: reads a JSON representation of a registry hive from standard input and creates or replaces the registry hive file given as argument. The written hive will always be in a slightly modified version 1.3 format. It's not the format windows would generate, but it should be understood by any conformant hive reader. Note that the representation chosen by PBCDEDIT currently throws away classname data (often used for feeble attempts at hiding stuff by Microsoft) and security descriptors, so if you write anything other than a BCD hive you will most likely destroy it. =back =head1 BCD STORE REPRESENTATION FORMAT A BCD data store is represented as a JSON object with one special key, C, and one key per BCD object. That is, each BCD object becomes one key-value pair in the object, and an additional key called C contains meta information. Here is an abridged example of a real BCD store: { "meta" : { "version" : 1 }, "{7ae02178-821d-11e7-8813-1c872c5f5ab0}" : { "type" : "application::osloader", "description" : "Windows 10", "device" : "partition=,harddisk,gpt,9742e468-9206-48a0-b4e4-c4e9745a356a,3ce6aceb-e90c-4fd2-9fba-47cab15f6faf", "osdevice" : "partition=,harddisk,gpt,9742e468-9206-48a0-b4e4-c4e9745a356a,3ce6aceb-e90c-4fd2-9fba-47cab15f6faf", "path" : "\\Windows\\system32\\winload.exe", "systemroot" : "\\Windows" }, "{bootloadersettings}" : { "inherit" : "{globalsettings} {hypervisorsettings}" }, "{bootmgr}" : { "description" : "Windows Boot Manager", "device" : "partition=,harddisk,mbr,ff3ba63b,1048576", "displayorder" : "{7ae02178-821d-11e7-8813-1c872c5f5ab0}", "inherit" : "{globalsettings}", "displaybootmenu" : 0, "timeout" : 30 }, "{globalsettings}" : { "inherit" : "{dbgsettings} {emssettings} {badmemory}" }, "{hypervisorsettings}" : { "hypervisorbaudrate" : 115200, "hypervisordebugport" : 1, "hypervisordebugtype" : 0 }, # ... } =head2 Minimal BCD to boot windows Experimentally I found the following BCD is the minimum required to successfully boot any post-XP version of Windows (assuming suitable C and C values, of course, and assuming a BIOS boot - for UEFI, you should use F instead of F): { "{bootmgr}" : { "default" : "{45b547a7-8ca6-4417-9eb0-a257b61f35b4}" }, "{45b547a7-8ca6-4417-9eb0-a257b61f35b1}" : { "type" : "application::osloader", "description" : "Windows Boot", "device" : "legacypartition=,harddisk,mbr,47cbc08a,1", "osdevice" : "legacypartition=,harddisk,mbr,47cbc08a,1", "path" : "\\Windows\\system32\\winload.exe", "systemroot" : "\\Windows" }, } Note that minimal doesn't mean recommended - Windows itself will add stuff to this during or after boot, and you might or might not run into issues when installing updates as it might not be able to find the F. This is how you would create a minimal hive with PBCDEDIT from within GNU/Linux, assuming F is the windows partition, using a random GUID for the osloader and using C instead of C: osldr="{$(uuidgen)}" part=$(pbcdedit bcd-device /dev/sdc3) pbcdedit create minimal.bcd \ set '{bootmgr}' default "$osldr" \ set "$osldr" type application::osloader \ set "$osldr" description 'Windows Boot' \ set "$osldr" device "$part" \ set "$osldr" osdevice "$part" \ set "$osldr" path '\Windows\system32\winload.exe' \ set "$osldr" systemroot '\Windows' =head2 The C key The C key is not stored in the BCD data store but is used only by PBCDEDIT. It is always generated when exporting, and importing will be refused when it exists and the version stored inside doesn't match the JSON schema version of PBCDEDIT. This ensures that different and incompatible versions of PBCDEDIT will not read and misinterpret each others data. =head2 The object keys Every other key is a BCD object. There is usually a BCD object for the boot manager, one for every boot option and a few others that store common settings inherited by these. Each BCD object is represented by a GUID wrapped in curly braces. These are usually random GUIDs used only to distinguish BCD objects from each other. When adding a new boot option, you can simply generate a new GUID. Some of these GUIDs are fixed well known GUIDs which PBCDEDIT will decode into human-readable strings such as C<{globalsettings}>, which is the same as C<{7ea2e1ac-2e61-4728-aaa3-896d9d0a9f0e}>. Each BCD object has an associated type. For example, C for objects loading Windows via F, C for real mode applications and so on. The type of a object is stored in the pseudo BCD element C (see next section). Some well-known objects have a default type. If an object type matches its default type, then the C element will be omitted. Similarly, if the C element is missing and the BCD object has a default type, the default type will be used when writing a BCD store. Running F will give you a list of object types, well-known object aliases and their default types. If different string keys in a JSON BCD store map to the same BCD object then a random one will "win" and the others will be discarded. To avoid this, you should always use the "canonical" name of a BCD object, which is the human-readable form (if it exists). =head2 The object values - BCD elements The value of each BCD object entry consists of key-value pairs called BCD elements. BCD elements are identified by a 32 bit number, but to make things simpler PBCDEDIT will replace these with well-known strings such as C, C or C. When PBCDEDIT does not know the BCD element, it will use C, where C is the 8-digit hex number of the BCD element. For example, C would be C. You can get a list of all BCD elements known to PBCDEDIT by running F. What was said about duplicate keys mapping to the same object is true for elements as well, so, again, you should always use the canonical name, which is the human readable alias, if known. =head3 BCD element types Each BCD element has a type such as I or I. This type determines how the value is interpreted, and most of them are pretty easy to explain: =over =item string This is simply a unicode string. For example, the C and C elements both are of this type, one storing a human-readable name for this boot option, the other a file path to the windows root directory: "description" : "Windows 10", "systemroot" : "\\Windows", =item boolean Almost as simple are booleans, which represent I/I, I/I and similar values. In the JSON form, true is represented by the number C<1>, and false is represented by the number C<0>. Other values will be accepted, but PBCDEDIT doesn't guarantee how these are interpreted. For example, C is a boolean that decides whether to enable the C boot menu. In the example BCD store above, this is disabled: "displaybootmenu" : 0, =item integer Again, very simple, this is a 64 bit integer. It can be either specified as a decimal number, as a hex number (by prefixing it with C<0x>) or as a binary number (prefix C<0b>). For example, the boot C is an integer, specifying the automatic boot delay in seconds: "timeout" : 30, =item integer list This is a list of 64 bit integers separated by whitespace. It is not used much, so here is a somewhat artificial and untested example of using C to specify a certain custom, eh, action to be executed when pressing C at boot: "customactions" : "0x1000044000001 0x54000001", =item guid This represents a single GUID value wrapped in curly braces. It is used a lot to refer from one BCD object to other one. For example, The C<{bootmgr}> object might refer to a resume boot option using C: "default" : "{7ae02178-821d-11e7-8813-1c872c5f5ab0}", Human readable aliases are used and allowed. =item guid list Similar to the GUID type, this represents a list of such GUIDs, separated by whitespace from each other. For example, many BCD objects can I elements from other BCD objects by specifying the GUIDs of those other objects in a GUID list called surprisingly called C: "inherit" : "{dbgsettings} {emssettings} {badmemory}", This example also shows how human readable aliases can be used. =item device This type is why I write I are easy to explain earlier: This type is the pinnacle of Microsoft-typical hacks layered on top of other hacks. Understanding this type took more time than writing all the rest of PBCDEDIT, and because it is so complex, this type has its own subsection below. =back =head3 The BCD "device" element type Device elements specify, well, devices. They are used for such diverse purposes such as finding a TFTP network boot image, serial ports or VMBUS devices, but most commonly they are used to specify the disk (harddisk, cdrom, ramdisk, vhd...) to boot from. The device element is kind of a mini-language in its own which is much more versatile then the limited windows interface to it - BCDEDIT - reveals. While some information can be found on the BCD store and the windows registry, there is pretty much no public information about the device element, so almost everything known about it had to be researched first in the process of writing this script, and consequently, support for BCD device elements is partial only. On the other hand, the expressive power of PBCDEDIT in specifying devices is much greater than BCDEDIT and therefore more can be done with it. The downside is that BCD device elements are much more complicated than what you might think from reading the BCDEDIT documentation. In other words, simple things are complicated, and complicated things are possible. Anyway, the general syntax of device elements is an optional GUID, followed by a device type, optionally followed by hexadecimal flags in angle brackets, optionally followed by C<=> and a comma-separated list of arguments, some of which can be (and often are) in turn devices again. [{GUID}]type[][=arg,arg...] Here are some examples: boot {b097d29f-bc00-11e9-8a9a-525400123456}block=file,,\EFI locate=,element,systemroot partition=,harddisk,mbr,47cbc08a,1048576 partition=,harddisk,gpt,9742e468-9206-48a0-b4e4-c4e9745a356a,76d39e5f-ad1b-407e-9c05-c81eb83b57dd block<1>=ramdisk,,harddisk,mbr,47cbc08a,68720525312>,0,0,0,\Recovery\b097d29e-bc00-11e9-8a9a-525400123456\Winre.wim block=file,,harddisk,gpt,9742e468-9206-48a0-b4e4-c4e9745a356a,ee3a393a-f0de-4057-9946-88584245ed48>,\ binary=050000000000000048000000000000000000000000000000000000000000000000000000000000000 I hope you are suitably impressed. I was, too, when I realized decoding these binary blobs is not as easy as I had assumed. The optional prefixed GUID seems to refer to a device BCD object, which can be used to specify more device-specific BCD elements (for example C and C). The flags after the type are omitted when they are C<0>. The only known flag is C<1>, which seems to indicate that the parent device is invalid. I don't claim to fully understand it, but it seems to indicate that the boot manager has to search the device itself. Why the device is specified in the first place escapes me, but a lot of this device stuff seems to be badly hacked together... The types understood and used by PBCDEDIT are as follows (keep in mind that not of all the following is necessarily supported in PBCDEDIT): =over =item CI This type isn't actually a real BCD element type, but a fallback for those cases where PBCDEDIT can't perfectly decode a device element (except for the leading GUID, which it can always decode). In such cases, it will convert the device into this type with a hexdump of the element data. =item C This is another special type - sometimes, a device is all zero-filled, which is not valid. This can mark the absence of a device or something PBCDEDIT does not understand, so it decodes it into this special "all zero" type called C. It's most commonly found in devices that can use an optional parent device, when no parent device is used. =item C Another type without parameters, this refers to the device that was booted from (nowadays typically the EFI system partition). =item CI,I This specifies a VMBUS device with the given interface type and interface instance, both of which are "naked" (no curly braces) GUIDs. Made-up example (couldn't find a single example on the web): vmbus=c376c1c3-d276-48d2-90a9-c04748072c60,12345678-a234-b234-c234-d2345678abcd =item C>,I,I,I,I This designates a specific partition on a block device. I is an optional parent device on which to search on, and is often C. Note that the angle brackets around I are part of the syntax. I is one of C, C, C, C, C or C, where the first three should be self-explaining, C is usually used to locate a file to be used as a disk image, and C is used to treat files as virtual harddisks, i.e. F and F files. The I is either C, C or C, the latter being used for devices without partitions, such as cdroms, where the "partition" is usually the whole device. The I identifies the disk or device using a unique signature, and the same is true for the I. How these are interpreted depends on the I: =over =item C The C is the 32 bit disk signature stored at offset 0x1b8 in the MBR, interpreted as a 32 bit unsigned little endian integer and written as hex number. That is, the bytes C<01 02 03 04> would become C<04030201>. Diskpart (using the C command) and the C command typically found on GNU/Linux systems (using e.g. C) can display the I. The I is the byte offset(!) of the partition counting from the beginning of the MBR. Example, use the partition on the harddisk with I C<47cbc08a> starting at sector C<2048> (= 1048576 / 512). partition=,harddisk,mbr,47cbc08a,1048576 =item C The I is the disk GUID/disk identifier GUID from the partition table (as displayed e.g. by F), and the I is the partition unique GUID (displayed using e.g. the F F command). Example: use the partition C<76d39e5f-ad1b-407e-9c05-c81eb83b57dd> on GPT disk C<9742e468-9206-48a0-b4e4-c4e9745a356a>. partition=,harddisk,gpt,9742e468-9206-48a0-b4e4-c4e9745a356a,76d39e5f-ad1b-407e-9c05-c81eb83b57dd =item C Instead of I and I, this type only accepts a decimal disk number and signifies the whole disk. BCDEDIT cannot display the resulting device, and I am doubtful whether it has a useful effect. =back =item C>,I,I,I,I This is exactly the same as the C type, except for a tiny detail: instead of using the partition start offset, this type uses the partition number for MBR disks. Behaviour other partition types should be the same. The partition number starts at C<1> and skips unused partition, so if there are two primary partitions and another partition inside the extended partition, the primary partitions are number C<1> and C<2> and the partition inside the extended partition is number C<3>, regardless of any gaps. =item C>,I,I This device description will make the bootloader search for a partition with a given path. The I device is the device to search on (angle brackets are still part of the syntax!) If it is C, then C will search all disks it can find. I is either C or C, and merely distinguishes between two different ways to specify the path to search for: C uses an element ID (either as hex or as name) as I and C uses a relative path as I. Example: find any partition which has the F path in the root. locate=,path,\magicfile.xxx Example: find any partition which has the path specified in the C element (typically F<\Windows>). locate=,element,systemroot =item CI,I Last not least, the most complex type, C, which... specifies block devices (which could be inside a F file for example). I is one of C, C, C, C, C or C - the same as for C. The remaining arguments change depending on the I: =over =item C,>,I Interprets the I device (typically a partition) as a filesystem and specifies a file path inside. =item C,> Pretty much just changes the interpretation of I, which is usually a disk image (C) to be a F or F file. =item C,>,I,I,I,I Interprets the I device as RAM disk, using the (decimal) base address, byte size and byte offset inside a file specified by I. The numbers are usually all C<0> because they can be extracted from the RAM disk image or other parameters. This is most commonly used to boot C images. =item C,I Refers to a removable drive identified by a number. BCDEDIT cannot display the resulting device, and it is not clear what effect it will have. =item C,I Pretty much the same as C but for CD-ROMs. =item anything else Probably not yet implemented. Tell me of your needs... =back =back =head4 Examples This concludes the syntax overview for device elements, but probably leaves many questions open. I can't help with most of them, as I also have many questions, but I can walk you through some actual examples using more complex aspects. =over =item C<< locate=,path,\disk.vhdx>,\disk.vhdx>>,element,path >> Just like with C declarations, you best treat device descriptors as instructions to find your device and work your way from the inside out: locate=,path,\disk.vhdx First, the innermost device descriptor searches all partitions on the system for a file called F<\disk.vhdx>: block=file,,\disk.vhdx Next, this takes the device locate has found and finds a file called F<\disk.vhdx> on it. This is the same file locate was using, but that is only because we find the device using the same path as finding the disk image, so this is purely incidental, although quite common. Next, this file will be opened as a virtual disk: block=vhd, And finally, inside this disk, another C will look for a partition with a path as specified in the C element, which most likely will be F<\Windows\system32\winload.exe>: locate=,element,path As a result, this will boot the first Windows it finds on the first F disk image it can find anywhere. =item C<< locate=,harddisk,mbr,47cbc08a,242643632128>,\win10.vhdx>>,element,path >> Pretty much the same as the previous case, but with a bit of variance. First, look for a specific partition on an MBR-partitioned disk: partition=,harddisk,mbr,47cbc08a,242643632128 Then open the file F<\win10.vhdx> on that partition: block=file,,\win10.vhdx Then, again, the file is opened as a virtual disk image: block=vhd, And again the windows loader (or whatever is in C) will be searched: locate=,element,path =item C<< {b097d2b2-bc00-11e9-8a9a-525400123456}block<1>=ramdisk,,harddisk,mbr,47cbc08a,242643632128>,0,0,0,\boot.wim >> This is quite different. First, it starts with a GUID. This GUID belongs to a BCD object of type C, which has additional parameters: "{b097d2b2-bc00-11e9-8a9a-525400123456}" : { "type" : "device", "description" : "sdi file for ramdisk", "ramdisksdidevice" : "partition=,harddisk,mbr,47cbc08a,1048576", "ramdisksdipath" : "\boot.sdi" }, I will not go into many details, but this specifies a (presumably empty) template ramdisk image (F<\boot.sdi>) that is used to initialize the ramdisk. The F<\boot.wim> file is then extracted into it. As you can also see, this F<.sdi> file resides on a different C. Continuing, as always, from the inside out, first this device descriptor finds a specific partition: partition=,harddisk,mbr,47cbc08a,242643632128 And then specifies a C image on this partition: block<1>=ramdisk,,0,0,0,\boot.wim I don't know what the purpose of the C<< <1> >> flag value is, but it seems to be always there on this kind of entry. If you have some good examples to add here, feel free to mail me. =back =head1 EDITING BCD STORES The C and C subcommands allow you to read a BCD data store and modify it or extract data from it. This is done by executing a series of "editing instructions" which are explained here. =over =item C I I Reads the BCD element I from the BCD object I and writes it to standard output, followed by a newline. The I can be a GUID or a human-readable alias, or the special string C<{default}>, which will refer to the default BCD object. Example: find description of the default BCD object. pbcdedit parse BCD get "{default}" description =item C I I I Similar to C, but sets the element to the given I instead. Example: change the bootmgr default too C<{b097d2ad-bc00-11e9-8a9a-525400123456}>: pbcdedit edit BCD set "{bootmgr}" default "{b097d2ad-bc00-11e9-8a9a-525400123456}" =item C I I Similar to C, but removed the BCD element from the specified BCD object. =item C I This takes the next argument, interprets it as Perl code and evaluates it. This allows you to do more complicated modifications or extractions. The following variables are predefined for your use: =over =item C<$PATH> The path to the BCD data store, as given to C or C. =item C<$BCD> The decoded BCD data store. =item C<$DEFAULT> The default BCD object name. =back The example given for C, above, could be expressed like this with C: pbcdedit edit BCD eval 'say $BCD->{$DEFAULT}{description}' The example given for C could be expressed like this: pbcdedit edit BCD eval '$BCD->{"{bootmgr}"}{default} = "{b097d2ad-bc00-11e9-8a9a-525400123456}"' =item C I Similar to C, above, but instead of using the argument as perl code, it loads the perl code from the given file and executes it. This makes it easier to write more complicated or larger programs. =back =head1 SEE ALSO For ideas on what you can do with BCD stores in general, and some introductory material, try L. For good reference on which BCD objects and elements exist, see Geoff Chappell's pages at L. =head1 AUTHOR Written by Marc A. Lehmann L. =head1 REPORTING BUGS Bugs can be reported directly the author at L. =head1 BUGS AND SHORTCOMINGS This should be a module. Of a series of modules, even. Registry code should preserve classname and security descriptor data, and whatever else is necessary to read and write any registry hive file. I am also not happy with device descriptors being strings rather than a data structure, but strings are probably better for command line usage. In any case, device descriptors could be converted by simply "splitting" at "=" and "," into an array reference, recursively. =head1 HOMEPAGE Original versions of this program can be found at L. =head1 COPYRIGHT Copyright 2019 Marc A. Lehmann, licensed under GNU GPL version 3 or later, see L. This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. =cut # common sense is optional, but recommended BEGIN { eval { require "common/sense.pm"; } && common::sense->import } no warnings 'portable'; # avoid 32 bit integer warnings use Encode (); use List::Util (); use IO::Handle (); use Time::HiRes (); eval { unpack "Q", pack "Q", 1 } or die "perl with 64 bit integer supported required.\n"; our $JSON = eval { require JSON::XS; JSON::XS:: } // eval { require JSON::PP; JSON::PP:: } // die "either JSON::XS or JSON::PP must be installed\n"; our $json_coder = $JSON->new->utf8->pretty->canonical->relaxed; # hack used for debugging sub xxd($$) { open my $xxd, "| xxd | sed -e 's/^/\Q$_[0]\E: /'"; syswrite $xxd, $_[1]; } # get some meta info on a file (uid, gid, perms) sub stat_get($) { [(stat shift)[4, 5, 2]] } # set stat info on a file sub stat_set($$) { my ($fh_or_path, $stat) = @_; return unless $stat; chown $stat->[0], $stat->[1], $fh_or_path; chmod +($stat->[2] & 07777), $fh_or_path; } sub file_load($) { my ($path) = @_; open my $fh, "<:raw", $path or die "$path: $!\n"; my $size = -s $fh; $size = read $fh, my $buf, $size or die "$path: short read\n"; $buf } sub file_save($$;$) { my ($path, $data, $stat) = @_; open my $fh, ">:raw", "$path~" or die "$path~: $!\n"; print $fh $data or die "$path~: short write\n"; stat_set $fh, $stat; $fh->sync; close $fh; rename "$path~", $path; } # sources and resources used for writing pbcdedit # # registry: # https://github.com/msuhanov/regf/blob/master/Windows%20registry%20file%20format%20specification.md # http://amnesia.gtisc.gatech.edu/~moyix/suzibandit.ltd.uk/MSc/ # bcd: # http://www.geoffchappell.com/notes/windows/boot/bcd/index.htm # https://docs.microsoft.com/en-us/previous-versions/windows/hardware/design/dn653287(v=vs.85) # bcd devices: # reactos' boot/environ/include/bl.h # windows .mof files ############################################################################# # registry stuff # we use a hardcoded securitya descriptor - full access for everyone my $sid = pack "H*", "010100000000000100000000"; # S-1-1-0 everyone my $ace = pack "C C S< L< a*", 0, 2, 8 + (length $sid), 0x000f003f, $sid; # type flags size mask sid my $sacl = ""; my $dacl = pack "C x S< S< x2 a*", 2, 8 + (length $ace), 1, $ace; # rev size count ace* my $sd = pack "C x S< L< L< L< L< a* a* a* a*", # rev flags(SE_DACL_PRESENT SE_SELF_RELATIVE) owner group sacl dacl 1, 0x8004, 20 + (length $sacl) + (length $dacl), 20 + (length $sacl) + (length $dacl) + (length $sid), 0, 20, $sacl, $dacl, $sid, $sid; my $sk = pack "a2 x2 x4 x4 x4 L< a*", sk => (length $sd), $sd; sub NO_OFS() { 0xffffffff } # file pointer "NULL" value sub KEY_HIVE_ENTRY() { 0x0004 } sub KEY_NO_DELETE () { 0x0008 } sub KEY_COMP_NAME () { 0x0020 } sub VALUE_COMP_NAME() { 0x0001 } my @regf_typename = qw( none sz expand_sz binary dword dword_be link multi_sz resource_list full_resource_descriptor resource_requirements_list qword qword_be ); my %regf_dec_type = ( sz => sub { $_[0] =~ s/\x00\x00$//; Encode::decode "UTF-16LE", $_[0] }, expand_sz => sub { $_[0] =~ s/\x00\x00$//; Encode::decode "UTF-16LE", $_[0] }, link => sub { $_[0] =~ s/\x00\x00$//; Encode::decode "UTF-16LE", $_[0] }, multi_sz => sub { $_[0] =~ s/(?:\x00\x00)?\x00\x00$//; [ split /\x00/, (Encode::decode "UTF-16LE", $_[0]), -1 ] }, dword => sub { unpack "L<", shift }, dword_be => sub { unpack "L>", shift }, qword => sub { unpack "Q<", shift }, qword_be => sub { unpack "Q>", shift }, ); my %regf_enc_type = ( sz => sub { (Encode::encode "UTF-16LE", $_[0]) . "\x00\x00" }, expand_sz => sub { (Encode::encode "UTF-16LE", $_[0]) . "\x00\x00" }, link => sub { (Encode::encode "UTF-16LE", $_[0]) . "\x00\x00" }, multi_sz => sub { (join "", map +(Encode::encode "UTF-16LE", $_) . "\x00\x00", @{ $_[0] }) . "\x00\x00" }, dword => sub { pack "L<", shift }, dword_be => sub { pack "L>", shift }, qword => sub { pack "Q<", shift }, qword_be => sub { pack "Q>", shift }, ); # decode a registry hive sub regf_decode($) { my ($hive) = @_; "regf" eq substr $hive, 0, 4 or die "not a registry hive\n"; my ($major, $minor) = unpack "\@20 L< L<", $hive; $major == 1 or die "registry major version is not 1, but $major\n"; $minor >= 2 && $minor <= 6 or die "registry minor version is $minor, only 2 .. 6 are supported\n"; my $bins = substr $hive, 4096; my $decode_key = sub { my ($ofs) = @_; my @res; my ($sze, $sig) = unpack "\@$ofs l< a2", $bins; $sze < 0 or die "key node points to unallocated cell\n"; $sig eq "nk" or die "expected key node at $ofs, got '$sig'\n"; my ($flags, $snum, $sofs, $vnum, $vofs, $knamesze) = unpack "\@$ofs ( \@6 S< \@24 L< x4 L< x4 L< L< \@76 S< )", $bins; my $kname = unpack "\@$ofs x80 a$knamesze", $bins; # classnames, security descriptors #my ($cofs, $xofs, $clen) = unpack "\@$ofs ( \@44 L< L< \@72 S< )", $bins; #if ($cofs != NO_OFS && $clen) { # #warn "cofs $cofs+$clen\n"; # xxd substr $bins, $cofs, 16; #} $kname = Encode::decode "UTF-16LE", $kname unless $flags & KEY_COMP_NAME; if ($vnum && $vofs != NO_OFS) { for ($vofs += 4; $vnum--; $vofs += 4) { my $kofs = unpack "\@$vofs L<", $bins; my ($sze, $sig) = unpack "\@$kofs l< a2", $bins; $sig eq "vk" or die "key values list contains invalid node (expected vk got '$sig')\n"; my ($nsze, $dsze, $dofs, $type, $flags) = unpack "\@$kofs x4 x2 S< L< L< L< L<", $bins; my $name = substr $bins, $kofs + 24, $nsze; $name = Encode::decode "UTF-16LE", $name unless $flags & VALUE_COMP_NAME; my $data; if ($dsze & 0x80000000) { $data = substr $bins, $kofs + 12, $dsze & 0x7; } elsif ($dsze > 16344 && $minor > 3) { # big data my ($bsze, $bsig, $bnum, $bofs) = unpack "\@$dofs l< a2 S< L<", $bins; for ($bofs += 4; $bnum--; $bofs += 4) { my $dofs = unpack "\@$bofs L<", $bins; my $dsze = unpack "\@$dofs l<", $bins; $data .= substr $bins, $dofs + 4, -$dsze - 4; } $data = substr $data, 0, $dsze; # cells might be longer than data } else { $data = substr $bins, $dofs + 4, $dsze; } $type = $regf_typename[$type] if $type < @regf_typename; $data = ($regf_dec_type{$type} || sub { unpack "H*", shift }) ->($data); $res[0]{$name} = [$type, $data]; } } if ($sofs != NO_OFS) { my $decode_key = __SUB__; my $decode_subkeylist = sub { my ($sofs) = @_; my ($sze, $sig, $snum) = unpack "\@$sofs l< a2 S<", $bins; if ($sig eq "ri") { # index root for (my $lofs = $sofs + 8; $snum--; $lofs += 4) { __SUB__->(unpack "\@$lofs L<", $bins); } } else { my $inc; if ($sig eq "li") { # subkey list $inc = 4; } elsif ($sig eq "lf" or $sig eq "lh") { # subkey list with name hints or hashes $inc = 8; } else { die "expected subkey list at $sofs, found '$sig'\n"; } for (my $lofs = $sofs + 8; $snum--; $lofs += $inc) { my ($name, $data) = $decode_key->(unpack "\@$lofs L<", $bins); $res[1]{$name} = $data; } } }; $decode_subkeylist->($sofs); } ($kname, \@res); }; my ($rootcell) = unpack "\@36 L<", $hive; my ($rname, $root) = $decode_key->($rootcell); [$rname, $root] } # return a binary windows FILETIME struct sub filetime_now { my ($s, $ms) = Time::HiRes::gettimeofday; pack "Q<", ($s * 1_000_000 + $ms) * 10 + 116_444_736_000_000_000 # 1970-01-01 00:00:00 } # encode a registry hive sub regf_encode($) { my ($hive) = @_; my %typeval = map +($regf_typename[$_] => $_), 0 .. $#regf_typename; # the filetime is apparently used to verify log file validity, # so by generating a new timestamp the log files *should* automatically # become invalidated and windows would "self-heal" them. # (update: has been verified by reverse engineering) # possibly the fact that the two sequence numbers match might also # make windows think that the hive is not dirty and ignore logs. # (update: has been verified by reverse engineering) my $now = filetime_now; # we only create a single hbin my $bins = pack "a4 L< L< x8 a8 x4", "hbin", 0, 0, $now; # append cell to $bind, return offset my $cell = sub { my ($cell) = @_; my $res = length $bins; $cell .= "\x00" while 4 != (7 & length $cell); # slow and ugly $bins .= pack "l<", -(4 + length $cell); $bins .= $cell; $res }; my $sdofs = $cell->($sk); # add a dummy security descriptor my $sdref = 0; # refcount substr $bins, $sdofs + 8, 4, pack "L<", $sdofs; # flink substr $bins, $sdofs + 12, 4, pack "L<", $sdofs; # blink my $encode_key = sub { my ($kname, $kdata, $flags) = @_; my ($values, $subkeys) = @$kdata; if ($kname =~ /[^\x00-\xff]/) { $kname = Encode::encode "UTF-16LE", $kname; } else { $flags |= KEY_COMP_NAME; } # encode subkeys my @snames = map $_->[1], sort { $a->[0] cmp $b->[0] } map [(uc $_), $_], keys %$subkeys; # normally, we'd have to encode each name, but we assume one char is at most two utf-16 cp's my $maxsname = 4 * List::Util::max map length, @snames; my @sofs = map __SUB__->($_, $subkeys->{$_}, 0), @snames; # encode values my $maxvname = 4 * List::Util::max map length, keys %$values; my @vofs; my $maxdsze = 0; while (my ($vname, $v) = each %$values) { my $flags = 0; if ($vname =~ /[^\x00-\xff]/) { $vname = Encode::encode "UTF-16LE", $kname; } else { $flags |= VALUE_COMP_NAME; } my ($type, $data) = @$v; $data = ($regf_enc_type{$type} || sub { pack "H*", shift })->($data); my $dsze; my $dofs; if (length $data <= 4) { $dsze = 0x80000000 | length $data; $dofs = unpack "L<", pack "a4", $data; } else { $dsze = length $data; $dofs = $cell->($data); } $type = $typeval{$type} // ($type =~ /^[0-9]+\z/ ? $type : die "cannot encode type '$type'"); push @vofs, $cell->(pack "a2 S< L< L< L< S< x2 a*", vk => (length $vname), $dsze, $dofs, $type, $flags, $vname); $maxdsze = $dsze if $maxdsze < $dsze; } # encode key my $slist = @sofs ? $cell->(pack "a2 S< L<*", li => (scalar @sofs), @sofs) : NO_OFS; my $vlist = @vofs ? $cell->(pack "L<*", @vofs) : NO_OFS; my $kdata = pack " a2 S< a8 x4 x4 L< L< L< L< L< L< L< L< L< L< L< L< x4 S< S< a* ", nk => $flags, $now, (scalar @sofs), 0, $slist, NO_OFS, (scalar @vofs), $vlist, $sdofs, NO_OFS, $maxsname, 0, $maxvname, $maxdsze, length $kname, 0, $kname; ++$sdref; my $res = $cell->($kdata); substr $bins, $_ + 16, 4, pack "L<", $res for @sofs; $res }; my ($rname, $root) = @$hive; my $rofs = $encode_key->($rname, $root, KEY_HIVE_ENTRY | KEY_NO_DELETE); # 4 = root key if (my $pad = -(length $bins) & 4095) { $pad -= 4; $bins .= pack "l< x$pad", $pad + 4; } substr $bins, $sdofs + 16, 4, pack "L<", $sdref; # sd refcount substr $bins, 8, 4, pack "L<", length $bins; my $base = pack " a4 L< L< a8 L< L< L< L< L< L< L< a64 x396 ", regf => 1974, 1974, $now, 1, 3, 0, 1, $rofs, length $bins, 1, (Encode::encode "UTF-16LE", "\\pbcdedit.reg"); my $chksum = List::Util::reduce { $a ^ $b } unpack "L<*", $base; $chksum = 0xfffffffe if $chksum == 0xffffffff; $chksum = 1 if $chksum == 0; $base .= pack "L<", $chksum; $base = pack "a* \@4095 x1", $base; $base . $bins } # load and parse registry from file sub regf_load($) { my ($path) = @_; regf_decode file_load $path } # encode and save registry to file sub regf_save($$;$) { my ($path, $hive, $stat) = @_; $hive = regf_encode $hive; file_save $path, $hive, $stat; } ############################################################################# # bcd stuff # human-readable aliases for GUID object identifiers our %bcd_objects = ( '{0ce4991b-e6b3-4b16-b23c-5e0d9250e5d9}' => '{emssettings}', '{1afa9c49-16ab-4a5c-4a90-212802da9460}' => '{resumeloadersettings}', '{1cae1eb7-a0df-4d4d-9851-4860e34ef535}' => '{default}', '{313e8eed-7098-4586-a9bf-309c61f8d449}' => '{kerneldbgsettings}', '{4636856e-540f-4170-a130-a84776f4c654}' => '{dbgsettings}', '{466f5a88-0af2-4f76-9038-095b170dc21c}' => '{ntldr}', '{5189b25c-5558-4bf2-bca4-289b11bd29e2}' => '{badmemory}', '{6efb52bf-1766-41db-a6b3-0ee5eff72bd7}' => '{bootloadersettings}', '{7254a080-1510-4e85-ac0f-e7fb3d444736}' => '{ssetupefi}', '{7ea2e1ac-2e61-4728-aaa3-896d9d0a9f0e}' => '{globalsettings}', '{7ff607e0-4395-11db-b0de-0800200c9a66}' => '{hypervisorsettings}', '{9dea862c-5cdd-4e70-acc1-f32b344d4795}' => '{bootmgr}', '{a1943bbc-ea85-487c-97c7-c9ede908a38a}' => '{ostargettemplatepcat}', '{a5a30fa2-3d06-4e9f-b5f4-a01df9d1fcba}' => '{fwbootmgr}', '{ae5534e0-a924-466c-b836-758539a3ee3a}' => '{ramdiskoptions}', '{b012b84d-c47c-4ed5-b722-c0c42163e569}' => '{ostargettemplateefi}', '{b2721d73-1db4-4c62-bf78-c548a880142d}' => '{memdiag}', '{cbd971bf-b7b8-4885-951a-fa03044f5d71}' => '{setuppcat}', '{fa926493-6f1c-4193-a414-58f0b2456d1e}' => '{current}', ); # default types our %bcd_object_types = ( '{fwbootmgr}' => 0x10100001, '{bootmgr}' => 0x10100002, '{memdiag}' => 0x10200005, '{ntldr}' => 0x10300006, '{badmemory}' => 0x20100000, '{dbgsettings}' => 0x20100000, '{emssettings}' => 0x20100000, '{globalsettings}' => 0x20100000, '{bootloadersettings}' => 0x20200003, '{hypervisorsettings}' => 0x20200003, '{kerneldbgsettings}' => 0x20200003, '{resumeloadersettings}' => 0x20200004, '{ramdiskoptions}' => 0x30000000, ); # object types our %bcd_types = ( 0x10100001 => 'application::fwbootmgr', 0x10100002 => 'application::bootmgr', 0x10200003 => 'application::osloader', 0x10200004 => 'application::resume', 0x10100005 => 'application::memdiag', 0x10100006 => 'application::ntldr', 0x10100007 => 'application::setupldr', 0x10400008 => 'application::bootsector', 0x10400009 => 'application::startup', 0x1020000a => 'application::bootapp', 0x20100000 => 'settings', 0x20200001 => 'inherit::fwbootmgr', 0x20200002 => 'inherit::bootmgr', 0x20200003 => 'inherit::osloader', 0x20200004 => 'inherit::resume', 0x20200005 => 'inherit::memdiag', 0x20200006 => 'inherit::ntldr', 0x20200007 => 'inherit::setupldr', 0x20200008 => 'inherit::bootsector', 0x20200009 => 'inherit::startup', 0x20300000 => 'inherit::device', 0x30000000 => 'device', ); our %rbcd_objects = reverse %bcd_objects; our $RE_GUID = qr<([0-9a-f]{8})-([0-9a-f]{4})-([0-9a-f]{4})-([0-9a-f]{4})-([0-9a-f]{12})>i; sub dec_guid($) { my ($p1, $p2, $p3, $p4, $p5) = unpack "VvvH4H12", shift; sprintf "%08x-%04x-%04x-%s-%s", $p1, $p2, $p3, $p4, $p5; } sub enc_guid($) { $_[0] =~ /^$RE_GUID\z/o or return; pack "VvvH4H12", hex $1, hex $2, hex $3, $4, $5 } # "wguid" are guids wrapped in curly braces {...} also supporting aliases sub dec_wguid($) { my $guid = "{" . (dec_guid shift) . "}"; $bcd_objects{$guid} // $guid } sub enc_wguid($) { my ($guid) = @_; if (my $alias = $rbcd_objects{$guid}) { $guid = $alias; } $guid =~ /^\{($RE_GUID)\}\z/o or return; enc_guid $1 } sub BCDE_CLASS () { 0xf0000000 } sub BCDE_CLASS_LIBRARY () { 0x10000000 } sub BCDE_CLASS_APPLICATION () { 0x20000000 } sub BCDE_CLASS_DEVICE () { 0x30000000 } sub BCDE_CLASS_TEMPLATE () { 0x40000000 } sub BCDE_FORMAT () { 0x0f000000 } sub BCDE_FORMAT_DEVICE () { 0x01000000 } sub BCDE_FORMAT_STRING () { 0x02000000 } sub BCDE_FORMAT_GUID () { 0x03000000 } sub BCDE_FORMAT_GUID_LIST () { 0x04000000 } sub BCDE_FORMAT_INTEGER () { 0x05000000 } sub BCDE_FORMAT_BOOLEAN () { 0x06000000 } sub BCDE_FORMAT_INTEGER_LIST () { 0x07000000 } sub enc_integer($) { my $value = shift; $value = oct $value if $value =~ /^0[bBxX]/; unpack "H*", pack "Q<", $value } sub enc_device($$); sub dec_device($$); our %bcde_dec = ( BCDE_FORMAT_DEVICE , \&dec_device, # # for round-trip verification # BCDE_FORMAT_DEVICE , sub { # my $dev = dec_device $_[0]; # $_[0] eq enc_device $dev # or die "bcd device decoding does not round trip for $_[0]\n"; # $dev # }, BCDE_FORMAT_STRING , sub { shift }, BCDE_FORMAT_GUID , sub { dec_wguid enc_wguid shift }, BCDE_FORMAT_GUID_LIST , sub { join " ", map dec_wguid enc_wguid $_, @{+shift} }, BCDE_FORMAT_INTEGER , sub { unpack "Q", pack "a8", pack "H*", shift }, # integer might be 4 or 8 bytes - caused by ms coding bugs BCDE_FORMAT_BOOLEAN , sub { shift eq "00" ? 0 : 1 }, BCDE_FORMAT_INTEGER_LIST, sub { join " ", unpack "Q*", pack "H*", shift }, # not sure if this can be 4 bytes ); our %bcde_enc = ( BCDE_FORMAT_DEVICE , sub { binary => enc_device $_[0], $_[1] }, BCDE_FORMAT_STRING , sub { sz => shift }, BCDE_FORMAT_GUID , sub { sz => "{" . (dec_guid enc_wguid shift) . "}" }, BCDE_FORMAT_GUID_LIST , sub { multi_sz => [map "{" . (dec_guid enc_wguid $_) . "}", split /\s+/, shift ] }, BCDE_FORMAT_INTEGER , sub { binary => enc_integer shift }, BCDE_FORMAT_BOOLEAN , sub { binary => shift ? "01" : "00" }, BCDE_FORMAT_INTEGER_LIST, sub { binary => join "", map enc_integer $_, split /\s+/, shift }, ); # BCD Elements our %bcde_byclass = ( any => { 0x11000001 => 'device', 0x12000002 => 'path', 0x12000004 => 'description', 0x12000005 => 'locale', 0x14000006 => 'inherit', 0x15000007 => 'truncatememory', 0x14000008 => 'recoverysequence', 0x16000009 => 'recoveryenabled', 0x1700000a => 'badmemorylist', 0x1600000b => 'badmemoryaccess', 0x1500000c => 'firstmegabytepolicy', 0x1500000d => 'relocatephysical', 0x1500000e => 'avoidlowmemory', 0x1600000f => 'traditionalkseg', 0x16000010 => 'bootdebug', 0x15000011 => 'debugtype', 0x15000012 => 'debugaddress', 0x15000013 => 'debugport', 0x15000014 => 'baudrate', 0x15000015 => 'channel', 0x12000016 => 'targetname', 0x16000017 => 'noumex', 0x15000018 => 'debugstart', 0x12000019 => 'busparams', 0x1500001a => 'hostip', 0x1500001b => 'port', 0x1600001c => 'dhcp', 0x1200001d => 'key', 0x1600001e => 'vm', 0x16000020 => 'bootems', 0x15000022 => 'emsport', 0x15000023 => 'emsbaudrate', 0x12000030 => 'loadoptions', 0x16000040 => 'advancedoptions', 0x16000041 => 'optionsedit', 0x15000042 => 'keyringaddress', 0x11000043 => 'bootstatdevice', 0x12000044 => 'bootstatfilepath', 0x16000045 => 'preservebootstat', 0x16000046 => 'graphicsmodedisabled', 0x15000047 => 'configaccesspolicy', 0x16000048 => 'nointegritychecks', 0x16000049 => 'testsigning', 0x1200004a => 'fontpath', 0x1500004b => 'integrityservices', 0x1500004c => 'volumebandid', 0x16000050 => 'extendedinput', 0x15000051 => 'initialconsoleinput', 0x15000052 => 'graphicsresolution', 0x16000053 => 'restartonfailure', 0x16000054 => 'highestmode', 0x16000060 => 'isolatedcontext', 0x15000065 => 'displaymessage', 0x15000066 => 'displaymessageoverride', 0x16000068 => 'nobootuxtext', 0x16000069 => 'nobootuxprogress', 0x1600006a => 'nobootuxfade', 0x1600006b => 'bootuxreservepooldebug', 0x1600006c => 'bootuxdisabled', 0x1500006d => 'bootuxfadeframes', 0x1600006e => 'bootuxdumpstats', 0x1600006f => 'bootuxshowstats', 0x16000071 => 'multibootsystem', 0x16000072 => 'nokeyboard', 0x15000073 => 'aliaswindowskey', 0x16000074 => 'bootshutdowndisabled', 0x15000075 => 'performancefrequency', 0x15000076 => 'securebootrawpolicy', 0x17000077 => 'allowedinmemorysettings', 0x15000079 => 'bootuxtransitiontime', 0x1600007a => 'mobilegraphics', 0x1600007b => 'forcefipscrypto', 0x1500007d => 'booterrorux', 0x1600007e => 'flightsigning', 0x1500007f => 'measuredbootlogformat', 0x15000080 => 'displayrotation', 0x15000081 => 'logcontrol', 0x16000082 => 'nofirmwaresync', 0x11000084 => 'windowssyspart', 0x16000087 => 'numlock', 0x26000202 => 'skipffumode', 0x26000203 => 'forceffumode', 0x25000510 => 'chargethreshold', 0x26000512 => 'offmodecharging', 0x25000aaa => 'bootflow', 0x45000001 => 'devicetype', 0x42000002 => 'applicationrelativepath', 0x42000003 => 'ramdiskdevicerelativepath', 0x46000004 => 'omitosloaderelements', 0x47000006 => 'elementstomigrate', 0x46000010 => 'recoveryos', }, bootapp => { 0x26000145 => 'enablebootdebugpolicy', 0x26000146 => 'enablebootorderclean', 0x26000147 => 'enabledeviceid', 0x26000148 => 'enableffuloader', 0x26000149 => 'enableiuloader', 0x2600014a => 'enablemassstorage', 0x2600014b => 'enablerpmbprovisioning', 0x2600014c => 'enablesecurebootpolicy', 0x2600014d => 'enablestartcharge', 0x2600014e => 'enableresettpm', }, bootmgr => { 0x24000001 => 'displayorder', 0x24000002 => 'bootsequence', 0x23000003 => 'default', 0x25000004 => 'timeout', 0x26000005 => 'resume', 0x23000006 => 'resumeobject', 0x24000007 => 'startupsequence', 0x24000010 => 'toolsdisplayorder', 0x26000020 => 'displaybootmenu', 0x26000021 => 'noerrordisplay', 0x21000022 => 'bcddevice', 0x22000023 => 'bcdfilepath', 0x26000024 => 'hormenabled', 0x26000025 => 'hiberboot', 0x22000026 => 'passwordoverride', 0x22000027 => 'pinpassphraseoverride', 0x26000028 => 'processcustomactionsfirst', 0x27000030 => 'customactions', 0x26000031 => 'persistbootsequence', 0x26000032 => 'skipstartupsequence', 0x22000040 => 'fverecoveryurl', 0x22000041 => 'fverecoverymessage', }, device => { 0x35000001 => 'ramdiskimageoffset', 0x35000002 => 'ramdisktftpclientport', 0x31000003 => 'ramdisksdidevice', 0x32000004 => 'ramdisksdipath', 0x35000005 => 'ramdiskimagelength', 0x36000006 => 'exportascd', 0x35000007 => 'ramdisktftpblocksize', 0x35000008 => 'ramdisktftpwindowsize', 0x36000009 => 'ramdiskmcenabled', 0x3600000a => 'ramdiskmctftpfallback', 0x3600000b => 'ramdisktftpvarwindow', }, memdiag => { 0x25000001 => 'passcount', 0x25000002 => 'testmix', 0x25000003 => 'failurecount', 0x26000003 => 'cacheenable', 0x25000004 => 'testtofail', 0x26000004 => 'failuresenabled', 0x25000005 => 'stridefailcount', 0x26000005 => 'cacheenable', 0x25000006 => 'invcfailcount', 0x25000007 => 'matsfailcount', 0x25000008 => 'randfailcount', 0x25000009 => 'chckrfailcount', }, ntldr => { 0x22000001 => 'bpbstring', }, osloader => { 0x21000001 => 'osdevice', 0x22000002 => 'systemroot', 0x23000003 => 'resumeobject', 0x26000004 => 'stampdisks', 0x26000010 => 'detecthal', 0x22000011 => 'kernel', 0x22000012 => 'hal', 0x22000013 => 'dbgtransport', 0x25000020 => 'nx', 0x25000021 => 'pae', 0x26000022 => 'winpe', 0x26000024 => 'nocrashautoreboot', 0x26000025 => 'lastknowngood', 0x26000026 => 'oslnointegritychecks', 0x26000027 => 'osltestsigning', 0x26000030 => 'nolowmem', 0x25000031 => 'removememory', 0x25000032 => 'increaseuserva', 0x25000033 => 'perfmem', 0x26000040 => 'vga', 0x26000041 => 'quietboot', 0x26000042 => 'novesa', 0x26000043 => 'novga', 0x25000050 => 'clustermodeaddressing', 0x26000051 => 'usephysicaldestination', 0x25000052 => 'restrictapiccluster', 0x22000053 => 'evstore', 0x26000054 => 'uselegacyapicmode', 0x26000060 => 'onecpu', 0x25000061 => 'numproc', 0x26000062 => 'maxproc', 0x25000063 => 'configflags', 0x26000064 => 'maxgroup', 0x26000065 => 'groupaware', 0x25000066 => 'groupsize', 0x26000070 => 'usefirmwarepcisettings', 0x25000071 => 'msi', 0x25000072 => 'pciexpress', 0x25000080 => 'safeboot', 0x26000081 => 'safebootalternateshell', 0x26000090 => 'bootlog', 0x26000091 => 'sos', 0x260000a0 => 'debug', 0x260000a1 => 'halbreakpoint', 0x260000a2 => 'useplatformclock', 0x260000a3 => 'forcelegacyplatform', 0x260000a4 => 'useplatformtick', 0x260000a5 => 'disabledynamictick', 0x250000a6 => 'tscsyncpolicy', 0x260000b0 => 'ems', 0x250000c0 => 'forcefailure', 0x250000c1 => 'driverloadfailurepolicy', 0x250000c2 => 'bootmenupolicy', 0x260000c3 => 'onetimeadvancedoptions', 0x260000c4 => 'onetimeoptionsedit', 0x250000e0 => 'bootstatuspolicy', 0x260000e1 => 'disableelamdrivers', 0x250000f0 => 'hypervisorlaunchtype', 0x220000f1 => 'hypervisorpath', 0x260000f2 => 'hypervisordebug', 0x250000f3 => 'hypervisordebugtype', 0x250000f4 => 'hypervisordebugport', 0x250000f5 => 'hypervisorbaudrate', 0x250000f6 => 'hypervisorchannel', 0x250000f7 => 'bootux', 0x260000f8 => 'hypervisordisableslat', 0x220000f9 => 'hypervisorbusparams', 0x250000fa => 'hypervisornumproc', 0x250000fb => 'hypervisorrootprocpernode', 0x260000fc => 'hypervisoruselargevtlb', 0x250000fd => 'hypervisorhostip', 0x250000fe => 'hypervisorhostport', 0x250000ff => 'hypervisordebugpages', 0x25000100 => 'tpmbootentropy', 0x22000110 => 'hypervisorusekey', 0x22000112 => 'hypervisorproductskutype', 0x25000113 => 'hypervisorrootproc', 0x26000114 => 'hypervisordhcp', 0x25000115 => 'hypervisoriommupolicy', 0x26000116 => 'hypervisorusevapic', 0x22000117 => 'hypervisorloadoptions', 0x25000118 => 'hypervisormsrfilterpolicy', 0x25000119 => 'hypervisormmionxpolicy', 0x2500011a => 'hypervisorschedulertype', 0x25000120 => 'xsavepolicy', 0x25000121 => 'xsaveaddfeature0', 0x25000122 => 'xsaveaddfeature1', 0x25000123 => 'xsaveaddfeature2', 0x25000124 => 'xsaveaddfeature3', 0x25000125 => 'xsaveaddfeature4', 0x25000126 => 'xsaveaddfeature5', 0x25000127 => 'xsaveaddfeature6', 0x25000128 => 'xsaveaddfeature7', 0x25000129 => 'xsaveremovefeature', 0x2500012a => 'xsaveprocessorsmask', 0x2500012b => 'xsavedisable', 0x2500012c => 'kerneldebugtype', 0x2200012d => 'kernelbusparams', 0x2500012e => 'kerneldebugaddress', 0x2500012f => 'kerneldebugport', 0x25000130 => 'claimedtpmcounter', 0x25000131 => 'kernelchannel', 0x22000132 => 'kerneltargetname', 0x25000133 => 'kernelhostip', 0x25000134 => 'kernelport', 0x26000135 => 'kerneldhcp', 0x22000136 => 'kernelkey', 0x22000137 => 'imchivename', 0x21000138 => 'imcdevice', 0x25000139 => 'kernelbaudrate', 0x22000140 => 'mfgmode', 0x26000141 => 'event', 0x25000142 => 'vsmlaunchtype', 0x25000144 => 'hypervisorenforcedcodeintegrity', 0x21000150 => 'systemdatadevice', 0x21000151 => 'osarcdevice', 0x21000153 => 'osdatadevice', 0x21000154 => 'bspdevice', 0x21000155 => 'bspfilepath', }, resume => { 0x21000001 => 'filedevice', 0x22000002 => 'filepath', 0x26000003 => 'customsettings', 0x26000004 => 'pae', 0x21000005 => 'associatedosdevice', 0x26000006 => 'debugoptionenabled', 0x25000007 => 'bootux', 0x25000008 => 'bootmenupolicy', 0x26000024 => 'hormenabled', }, startup => { 0x26000001 => 'pxesoftreboot', 0x22000002 => 'applicationname', }, ); # mask, value => class our @bcde_typeclass = ( [0x00000000, 0x00000000, 'any'], [0xf00fffff, 0x1000000a, 'bootapp'], [0xf0ffffff, 0x2020000a, 'bootapp'], [0xf00fffff, 0x10000001, 'bootmgr'], [0xf00fffff, 0x10000002, 'bootmgr'], [0xf0ffffff, 0x20200001, 'bootmgr'], [0xf0ffffff, 0x20200002, 'bootmgr'], [0xf0f00000, 0x20300000, 'device'], [0xf0000000, 0x30000000, 'device'], [0xf00fffff, 0x10000005, 'memdiag'], [0xf0ffffff, 0x20200005, 'memdiag'], [0xf00fffff, 0x10000006, 'ntldr'], [0xf00fffff, 0x10000007, 'ntldr'], [0xf0ffffff, 0x20200006, 'ntldr'], [0xf0ffffff, 0x20200007, 'ntldr'], [0xf00fffff, 0x10000003, 'osloader'], [0xf0ffffff, 0x20200003, 'osloader'], [0xf00fffff, 0x10000004, 'resume'], [0xf0ffffff, 0x20200004, 'resume'], [0xf00fffff, 0x10000009, 'startup'], [0xf0ffffff, 0x20200009, 'startup'], ); our %rbcde_byclass; while (my ($k, $v) = each %bcde_byclass) { $rbcde_byclass{$k} = { reverse %$v }; } # decodes (numerical elem, type) to name sub dec_bcde_id($$) { for my $class (@bcde_typeclass) { if (($_[1] & $class->[0]) == $class->[1]) { if (my $id = $bcde_byclass{$class->[2]}{$_[0]}) { return $id; } } } sprintf "custom:%08x", $_[0] } # encodes (elem as name, type) sub enc_bcde_id($$) { $_[0] =~ /^custom:(?:0x)?([0-9a-fA-F]{8}$)/ and return hex $1; for my $class (@bcde_typeclass) { if (($_[1] & $class->[0]) == $class->[1]) { if (my $value = $rbcde_byclass{$class->[2]}{$_[0]}) { return $value; } } } undef } # decode/encode bcd device element - the horror, no documentaion # whatsoever, supercomplex, superinconsistent. our @dev_type = qw(block type1 legacypartition serial udp boot partition vmbus locate); our @block_type = qw(harddisk floppy cdrom ramdisk type4 file vhd); our @part_type = qw(gpt mbr raw); our $NULL_DEVICE = "\x00" x 16; # biggest bitch to decode, ever # this decodes a device portion after the GUID sub dec_device_($$); sub dec_device_($$) { my ($device, $type) = @_; my $res; my ($type, $flags, $length, $pad) = unpack "VVVV", substr $device, 0, 4 * 4, ""; $pad == 0 or die "non-zero reserved field in device descriptor\n"; if ($length == 0 && $type == 0 && $flags == 0) { return ("null", $device); } $length >= 16 or die "device element size too small ($length)\n"; $type = $dev_type[$type] // die "$type: unknown device type\n"; #d# warn "t<$type,$flags,$length,$pad>\n";#d# $res .= $type; $res .= sprintf "<%x>", $flags if $flags; my $tail = substr $device, $length - 4 * 4, 1e9, ""; $length == 4 * 4 + length $device or die "device length mismatch ($length != " . (16 + length $device) . ")\n"; my $dec_path = sub { my ($path, $error) = @_; $path =~ /^((?:..)*)\x00\x00\z/s or die "$error\n"; $path = Encode::decode "UTF-16LE", $1; $path }; if ($type eq "partition" or $type eq "legacypartition") { my $partdata = substr $device, 0, 16, ""; my ($blocktype, $parttype) = unpack "VV", substr $device, 0, 4 * 2, ""; $blocktype = $block_type[$blocktype] // die "unknown block device type '$blocktype'\n"; $parttype = $part_type[$parttype] // die "unknown partition type\n"; my $diskid = substr $device, 0, 16, ""; $diskid = $parttype eq "gpt" ? dec_guid substr $diskid, 0, 16 : sprintf "%08x", unpack "V", $diskid; my $partid = $parttype eq "gpt" ? dec_guid $partdata : $type eq "partition" ? unpack "Q<", $partdata # byte offset to partition start : unpack "L<", $partdata; # partition number, one-based (my $parent, $device) = dec_device_ $device, $type; $res .= "="; $res .= "<$parent>"; $res .= ",$blocktype,$parttype,$diskid,$partid"; # PartitionType (gpt, mbr, raw) # guid | partsig | disknumber } elsif ($type eq "boot") { $device =~ s/^\x00{56}\z// or die "boot device type with extra data not supported\n"; } elsif ($type eq "block") { my $blocktype = unpack "V", substr $device, 0, 4, ""; $blocktype = $block_type[$blocktype] // die "unknown block device type '$blocktype'\n"; # decode a "file path" structure my $dec_file = sub { my ($fver, $flen, $ftype) = unpack "VVV", substr $device, 0, 4 * 3, ""; my $path = substr $device, 0, $flen - 12, ""; $fver == 1 or die "unsupported file descriptor version '$fver'\n"; $ftype == 5 or die "unsupported file descriptor path type '$type'\n"; (my $parent, $path) = dec_device_ $path, $type; $path = $dec_path->($path, "file device without path"); ($parent, $path) }; if ($blocktype eq "file") { my ($parent, $path) = $dec_file->(); $res .= "=file,<$parent>,$path"; } elsif ($blocktype eq "vhd") { $device =~ s/^\x00{20}//s or die "virtualdisk has non-zero fields I don't understand\n"; (my $parent, $device) = dec_device_ $device, $type; $res .= "=vhd,<$parent>"; } elsif ($blocktype eq "ramdisk") { my ($base, $size, $offset) = unpack "Q< Q< L<", substr $device, 0, 8 + 8 + 4, ""; my ($subdev, $path) = $dec_file->(); $res .= "=ramdisk,<$subdev>,$base,$size,$offset,$path"; } else { die "unsupported block type '$blocktype'\n"; } } elsif ($type eq "locate") { # mode, bcde_id, unknown, string # we assume locate has _either_ an element id _or_ a path, but not both my ($mode, $elem, $parent) = unpack "VVV", substr $device, 0, 4 * 3, ""; if ($parent) { # not sure why this is an offset - it must come after the path $parent = substr $device, $parent - 4 * 3 - 4 * 4, 1e9, ""; ($parent, my $tail) = dec_device_ $parent, $type; 0 == length $tail or die "trailing data after locate device parent\n"; } else { $parent = "null"; } my $path = $device; $device = ""; $path = $dec_path->($path, "device locate mode without path"); $res .= "=<$parent>,"; if ($mode == 0) { # "Element" !length $path or die "device locate mode 0 having non-empty path ($mode, $elem, $path)\n"; $elem = dec_bcde_id $elem, $type; $res .= "element,$elem"; } elsif ($mode == 1) { # "String" !$elem or die "device locate mode 1 having non-zero element\n"; $res .= "path,$path"; } else { # mode 2 maybe called "ElementChild" with element and parent device? example needed die "device locate mode '$mode' not supported\n"; } } elsif ($type eq "vmbus") { my $type = dec_guid substr $device, 0, 16, ""; my $instance = dec_guid substr $device, 0, 16, ""; $device =~ s/^\x00{24}\z// or die "vmbus has non-zero fields I don't understand\n"; $res .= "=$type,$instance"; } else { die "unsupported device type '$type'\n"; } warn "unexpected trailing device data($res), " . unpack "H*",$device if length $device; #length $device # and die "unexpected trailing device data\n"; ($res, $tail) } # decode a full binary BCD device descriptor sub dec_device($$) { my ($device, $type) = @_; $device = pack "H*", $device; my $guid = dec_guid substr $device, 0, 16, ""; $guid = $guid eq "00000000-0000-0000-0000-000000000000" ? "" : "{$guid}"; eval { my ($dev, $tail) = dec_device_ $device, $type; $tail eq "" or die "unsupported trailing data after device descriptor\n"; "$guid$dev" # } // scalar ((warn $@), "$guid$fallback") } // ($guid . "binary=" . unpack "H*", $device) } sub indexof($@) { my $value = shift; for (0 .. $#_) { $value eq $_[$_] and return $_; } undef } # encode the device portion after the GUID sub enc_device_($$); sub enc_device_($$) { my ($device, $type) = @_; my $enc_path = sub { my $path = shift; $path =~ s/\//\\/g; (Encode::encode "UTF-16LE", $path) . "\x00\x00" }; my $enc_file = sub { my ($parent, $path) = @_; # parent and path must already be encoded $path = $parent . $path; # fver 1, ftype 5 pack "VVVa*", 1, 12 + length $path, 5, $path }; my $parse_path = sub { s/^([\/\\][^<>"|?*\x00-\x1f]*)// or die "$_: invalid path\n"; $enc_path->($1) }; my $parse_parent = sub { my $parent; if (s/^// or die "$device: syntax error: parent device not followed by '>'\n"; } else { $parent = $NULL_DEVICE; } $parent }; for ($device) { s/^([a-z]+)// or die "$_: device does not start with type string\n"; my $type = $1; my $flags = s/^<([0-9a-fA-F]+)>// ? hex $1 : 0; my $payload; if ($type eq "binary") { s/^=([0-9a-fA-F]+)// or die "binary type must have a hex string argument\n"; $payload = pack "H*", $1; } elsif ($type eq "null") { return ($NULL_DEVICE, $_); } elsif ($type eq "boot") { $payload = "\x00" x 56; } elsif ($type eq "partition" or $type eq "legacypartition") { s/^=// or die "$_: missing '=' after $type\n"; my $parent = $parse_parent->(); s/^,// or die "$_: comma missing after partition parent device\n"; s/^([a-z]+),// or die "$_: partition does not start with block type (e.g. hd or vhd)\n"; my $blocktype = $1; s/^([a-z]+),// or die "$_: partition block type not followed by partiton type\n"; my $parttype = $1; my ($partdata, $diskdata); if ($parttype eq "mbr") { s/^([0-9a-f]{8}),//i or die "$_: partition mbr disk id malformed (must be e.g. 1234abcd)\n"; $diskdata = pack "Vx12", hex $1; s/^([0-9]+)// or die "$_: partition number or offset is missing or malformed (must be decimal)\n"; # the following works for both 64 bit offset and 32 bit partno $partdata = pack "Q< x8", $1; } elsif ($parttype eq "gpt") { s/^($RE_GUID),// or die "$_: partition disk guid missing or malformed\n"; $diskdata = enc_guid $1; s/^($RE_GUID)// or die "$_: partition guid missing or malformed\n"; $partdata = enc_guid $1; } elsif ($parttype eq "raw") { s/^([0-9]+)// or die "$_: partition disk number missing or malformed (must be decimal)\n"; $partdata = pack "L< x12", $1; } else { die "$parttype: partition type not supported\n"; } $payload = pack "a16 L< L< a16 a*", $partdata, (indexof $blocktype, @block_type), (indexof $parttype, @part_type), $diskdata, $parent; } elsif ($type eq "locate") { s/^=// or die "$_: missing '=' after $type\n"; my ($mode, $elem, $path); my $parent = $parse_parent->(); s/^,// or die "$_: missing comma after locate parent device\n"; if (s/^element,//) { s/^([0-9a-z:]+)//i or die "$_ locate element must be either name or 8-digit hex id\n"; $elem = enc_bcde_id $1, $type; $mode = 0; $path = $enc_path->(""); } elsif (s/^path,//) { $mode = 1; $path = $parse_path->(); } else { die "$_ second locate argument must be subtype (either element or path)\n"; } if ($parent ne $NULL_DEVICE) { ($parent, $path) = (4 * 4 + 4 * 3 + length $path, "$path$parent"); } else { $parent = 0; } $payload = pack "VVVa*", $mode, $elem, $parent, $path; } elsif ($type eq "block") { s/^=// or die "$_: missing '=' after $type\n"; s/^([a-z]+),// or die "$_: block device does not start with block type (e.g. disk)\n"; my $blocktype = $1; my $blockdata; if ($blocktype eq "file") { my $parent = $parse_parent->(); s/^,// or die "$_: comma missing after file block device parent\n"; my $path = $parse_path->(); $blockdata = $enc_file->($parent, $path); } elsif ($blocktype eq "vhd") { $blockdata = "\x00" x 20; # ENOTUNDERSTOOD $blockdata .= $parse_parent->(); } elsif ($blocktype eq "ramdisk") { my $parent = $parse_parent->(); s/^,(\d+),(\d+),(\d+),//a or die "$_: missing ramdisk base,size,offset after ramdisk parent device\n"; my ($base, $size, $offset) = ($1, $2, $3); my $path = $parse_path->(); $blockdata = pack "Q< Q< L< a*", $base, $size, $offset, $enc_file->($parent, $path); } elsif ($blocktype eq "cdrom" or $blocktype eq "floppy") { # this is guesswork s/^(\d+)//a or die "$_: missing device number for cdrom\n"; $blockdata = pack "V", $1; } else { die "$blocktype: unsupported block type (must be file, vhd, ramdisk, floppy, cdrom)\n"; } $payload = pack "Va*", (indexof $blocktype, @block_type), $blockdata; } elsif ($type eq "vmbus") { s/^=($RE_GUID)// or die "$_: malformed or missing vmbus interface type guid\n"; my $type = enc_guid $1; s/^,($RE_GUID)// or die "$_: malformed or missing vmbus interface instance guid\n"; my $instance = enc_guid $1; $payload = pack "a16a16x24", $type, $instance; # } elsif ($type eq "udp") { # $payload = pack "Va16", 1, "12345678"; } else { die "$type: not a supported device type (binary, null, boot, legacypartition, partition, block, locate)\n"; } return ( (pack "VVVVa*", (indexof $type, @dev_type), $flags, 16 + length $payload, 0, $payload), $_ ); } } # encode a full binary BCD device descriptor sub enc_device($$) { my ($device, $type) = @_; my $guid = "\x00" x 16; if ($device =~ s/^\{([A-Za-z0-9\-]+)\}//) { $guid = enc_guid $1 or die "$device: does not start with valid guid\n"; } my ($descriptor, $tail) = enc_device_ $device, $type; length $tail and die "$device: garbage after device descriptor\n"; unpack "H*", $guid . $descriptor } # decode a registry hive into the BCD structure used by pbcdedit sub bcd_decode { my ($hive) = @_; my %bcd; my $objects = $hive->[1][1]{Objects}[1]; while (my ($k, $v) = each %$objects) { my %kv; $v = $v->[1]; $k = $bcd_objects{$k} // $k; my $type = $v->{Description}[0]{Type}[1]; if ($type != $bcd_object_types{$k}) { $kv{type} = $bcd_types{$type} // sprintf "0x%08x", $type; } my $elems = $v->{Elements}[1]; while (my ($k, $v) = each %$elems) { my $k = hex $k; my $v = $bcde_dec{$k & BCDE_FORMAT}->($v->[0]{Element}[1], $type); my $k = dec_bcde_id $k, $type; $kv{$k} = $v; } $bcd{$k} = \%kv; } $bcd{meta} = { version => $JSON_VERSION }; \%bcd } # encode a pbcdedit structure into a registry hive sub bcd_encode { my ($bcd) = @_; if (my $meta = $bcd->{meta}) { $meta->{version} eq $JSON_VERSION or die "BCD meta version ($meta->{version}) does not match executable version ($JSON_VERSION)\n"; } my %objects; my %rbcd_types = reverse %bcd_types; while (my ($k, $v) = each %$bcd) { my %kv; next if $k eq "meta"; $k = lc $k; # I know you windows types! my $type = $v->{type}; if ($type) { $type = $type =~ /^(?:0x)[0-9a-fA-F]+$/ ? hex $type : $rbcd_types{$type} // die "$type: unable to parse bcd object type\n"; } my $guid = enc_wguid $k or die "$k: invalid bcd object identifier\n"; # default type if not given $type //= $bcd_object_types{dec_wguid $guid} // die "$k: unable to deduce bcd object type\n"; my %elem; while (my ($k, $v) = each %$v) { next if $k eq "type"; $k = (enc_bcde_id $k, $type) // die "$k: invalid bcde element name or id\n"; $elem{sprintf "%08x", $k} = [{ Element => [ ($bcde_enc{$k & BCDE_FORMAT} // die "$k: unable to encode unknown bcd element type}")->($v)] }]; } $guid = dec_guid $guid; $objects{"{$guid}"} = [undef, { Description => [{ Type => [dword => $type] }], Elements => [undef, \%elem], }]; } [NewStoreRoot => [undef, { Description => [{ KeyName => [sz => "BCD00000001"], System => [dword => 1], pbcdedit => [sz => $VERSION], # other values seen: GuidCache => ..., TreatAsSystem => 0x00000001 }], Objects => [undef, \%objects], }]] } ############################################################################# # edit instructions sub bcd_edit_eval { package pbcdedit; our ($PATH, $BCD, $DEFAULT); eval shift; die "$@" if $@; } sub bcd_edit { my ($path, $bcd, @insns) = @_; my $default = $bcd->{"{bootmgr}"}{default}; # prepare "officially visible" variables local $pbcdedit::PATH = $path; local $pbcdedit::BCD = $bcd; local $pbcdedit::DEFAULT = $default; while (@insns) { my $insn = shift @insns; if ($insn eq "get") { my $object = shift @insns; my $elem = shift @insns; $object = $object eq "{default}" ? $default : dec_wguid enc_wguid $object; print $bcd->{$object}{$elem}, "\n"; } elsif ($insn eq "set") { my $object = shift @insns; my $elem = shift @insns; my $value = shift @insns; $object = $object eq "{default}" ? $default : dec_wguid enc_wguid $object; $bcd->{$object}{$elem} = $value; } elsif ($insn eq "del") { my $object = shift @insns; my $elem = shift @insns; $object = $object eq "{default}" ? $default : dec_wguid enc_wguid $object; delete $bcd->{$object}{$elem}; } elsif ($insn eq "eval") { my $perl = shift @insns; bcd_edit_eval "#line 1 'eval'\n$perl"; } elsif ($insn eq "do") { my $path = shift @insns; my $file = file_load $path; bcd_edit_eval "#line 1 '$path'\n$file"; } else { die "$insn: not a recognized instruction for create/edit/parse\n"; } } } ############################################################################# # other utilities # json to stdout sub prjson($) { print $json_coder->encode ($_[0]); } # json from stdin sub rdjson() { my $json; 1 while read STDIN, $json, 65536, length $json; $json_coder->decode ($json) } sub lsblk() { my $lsblk = $json_coder->decode (scalar qx); for my $dev (@{ $lsblk->{blockdevices} }) { if ($dev->{type} eq "part") { # lsblk sometimes gives a bogus pttype, so we recreate it here $dev->{pttype} = $dev->{ptuuid} =~ /^$RE_GUID\z/ ? "gpt" : "dos"; if ($dev->{pttype} eq "gpt") { $dev->{bcd_device} = "partition=,harddisk,gpt,$dev->{ptuuid},$dev->{partuuid}"; } elsif ($dev->{pttype} eq "dos") { # why not "mbr" :( if ($dev->{partuuid} =~ /^([0-9a-f]{8})-([0-9a-f]{2})\z/i) { my ($diskid, $partno) = ($1, hex $2); $dev->{bcd_legacy_device} = "legacypartition=,harddisk,mbr,$diskid,$partno"; if (open my $fh, "/sys/class/block/$dev->{kname}/start") { my $start = 512 * readline $fh; $dev->{bcd_device} = "partition=,harddisk,mbr,$diskid,$start"; } } } } } $lsblk->{blockdevices} } sub prdev($$) { my ($path, $attribute) = @_; # rather than stat'ing and guessing how devices are encoded, we use lsblk for this my $mm = $json_coder->decode (scalar qx)->{blockdevices}[0]{"maj:min"}; my $lsblk = lsblk; for my $dev (@$lsblk) { if ($dev->{"maj:min"} eq $mm && $dev->{$attribute}) { say $dev->{$attribute}; exit 0; } } exit 1; } ############################################################################# # command line parser our %CMD = ( help => sub { require Pod::Usage; Pod::Usage::pod2usage (-verbose => 2, -quotes => "none", -noperldoc => 1); }, objects => sub { my %rbcd_types = reverse %bcd_types; $_ = sprintf "%08x", $_ for values %rbcd_types; if ($_[0] eq "--json") { my %default_type = %bcd_object_types; $_ = sprintf "%08x", $_ for values %default_type; prjson { version => $JSON_VERSION, object_alias => \%bcd_objects, object_type => \%rbcd_types, object_default_type => \%default_type, }; } else { my %rbcd_objects = reverse %bcd_objects; print "\n"; printf "%-9s %s\n", "Type", "Alias"; for my $tname (sort keys %rbcd_types) { printf "%-9s %s\n", $rbcd_types{$tname}, $tname; } print "\n"; printf "%-39s %-23s %s\n", "Object GUID", "Alias", "(Hex) Default Type"; for my $name (sort keys %rbcd_objects) { my $guid = $rbcd_objects{$name}; my $type = $bcd_object_types{$name}; my $tname = $bcd_types{$type}; $type = $type ? sprintf "(%08x) %s", $type, $tname : "-"; printf "%-39s %-23s %s\n", $guid, $name, $type; } print "\n"; } }, elements => sub { my $json = $_[0] eq "--json"; my %format_name = ( BCDE_FORMAT_DEVICE , "device", BCDE_FORMAT_STRING , "string", BCDE_FORMAT_GUID , "guid", BCDE_FORMAT_GUID_LIST , "guid list", BCDE_FORMAT_INTEGER , "integer", BCDE_FORMAT_BOOLEAN , "boolean", BCDE_FORMAT_INTEGER_LIST, "integer list", ); my @element; for my $class (sort keys %rbcde_byclass) { my $rbcde = $rbcde_byclass{$class}; unless ($json) { print "\n"; printf "Elements applicable to class(es): $class\n"; printf "%-9s %-12s %s\n", "Element", "Format", "Name Alias"; } for my $name (sort keys %$rbcde) { my $id = $rbcde->{$name}; my $format = $format_name{$id & BCDE_FORMAT}; if ($json) { push @element, [$class, $id * 1, $format, $name]; } else { $id = sprintf "%08x", $id; printf "%-9s %-12s %s\n", $id, $format, $name; } } } print "\n" unless $json; prjson { version => $JSON_VERSION, element => \@element, class => \@bcde_typeclass, } if $json; }, export => sub { prjson bcd_decode regf_load shift; }, import => sub { regf_save shift, bcd_encode rdjson; }, create => sub { my $path = shift; my $stat = stat_get $path; # should actually be done at file load time my $bcd = { }; bcd_edit $path, $bcd, @_; regf_save $path, bcd_encode $bcd; stat_set $path, $stat; }, edit => sub { my $path = shift; my $stat = stat_get $path; # should actually be done at file load time my $bcd = bcd_decode regf_load $path; bcd_edit $path, $bcd, @_; regf_save $path, bcd_encode $bcd; stat_set $path, $stat; }, parse => sub { my $path = shift; my $bcd = bcd_decode regf_load $path; bcd_edit $path, $bcd, @_; }, "export-regf" => sub { prjson regf_load shift; }, "import-regf" => sub { regf_save shift, rdjson; }, lsblk => sub { my $json = $_[0] eq "--json"; my $lsblk = lsblk; if ($json) { prjson $lsblk; } else { printf "%-10s %-8.8s %-6.6s %-3s %s\n", "DEVICE", "LABEL", "FSTYPE", "PT", "DEVICE DESCRIPTOR"; for my $dev (@$lsblk) { for my $bcd ($dev->{bcd_device}, $dev->{bcd_legacy_device}) { printf "%-10s %-8.8s %-6.6s %-3s %s\n", $dev->{path}, $dev->{label}, $dev->{fstype}, $dev->{pttype}, $bcd if $bcd; } } } }, "bcd-device" => sub { prdev shift, "bcd_device"; }, "bcd-legacy-device" => sub { prdev shift, "bcd_legacy_device"; }, version => sub { print "\n", "PBCDEDIT version $VERSION, copyright 2019 Marc A. Lehmann .\n", "JSON schema version: $JSON_VERSION\n", "Licensed under the GNU General Public License Version 3.0, or any later version.\n", "\n", $CHANGELOG, "\n"; }, ); my $cmd = shift; unless (exists $CMD{$cmd}) { warn "Usage: $0 subcommand args...\nTry $0 help\n"; exit 126; } $CMD{$cmd}->(@ARGV);