#!/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.014; # numerous features our $VERSION = '1.0'; our $JSON_VERSION = 1; # the versiobn of the json objects generated by this program =head1 NAME pbcdedit - portable boot configuration data (BCD) store editor =head1 SYNOPSIS pbcdedit help # output manual page pbcdedit export path/to/BCD # output BCD hive as JSON pbcdedit import path/to/bcd # convert standard input to BCD hive pbcdedit edit path/to/BCD edit-instructions... pbcdedit objects # list all supported object aliases and types pbcdedit elements # list all supported bcd element aliases =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. 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.14. =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 rewady 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 data stores. =head1 SUBCOMMANDS PCBEDIT expects a subcommand as first argument that tells it what to do. The following subcommands exist: =over =item help Displays the whole manuale page (this document). =item export 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 wiht an extenral program, write it again. pbcdedit export BCD | modify-json-somehow | pbcdedit import BCD =item import 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 edit F instructions... Load a BCD data store, apply some instructions to it, and save it again. See the section L, below, for more info. =item parse F instructions... Same as C, above, except it doesn't save the data store again. Can be useful to extract some data from it. =item lsblk 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 descritpors for MBR partitions. =item objects [--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 elements [--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 export-regf F This has nothing to do with BCD data stores - 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 import-regf 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 clasname data (often used for feeble attemtps 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 DATA 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 (suitable C and C values, of course): { "{bootmgr}" : { "resumeobject" : "{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. =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 store the JSON schema version of PBCDEDIT. This ensures that differemt and incompatible versions of PBCDEDIT will not read and misinterĂ¼ret 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, whcih is the human radable 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 simnple 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 binatry 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 an untested exanmple 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 wrqapped 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: "resumeobject" : "{7ae02178-821d-11e7-8813-1c872c5f5ab0}", Human readable aliases are used and allowed. =item guid list Similar to te 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 ina 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 =head4 The BCD "device" element type Device elements specify, well, devices. They are used for such diverse purposes such as finding a TFTP network boot imagem 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 bigger than BCDEDIT and therefore more cna be don 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 hexdecimal 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 binary=hex... 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 null This is another special type - sometimes, a device 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 boot Another type without parameters, this refers to the device that was booted from (nowadays typically the EFI system partition). =item vmbus=interfacetype,interfaceinstance 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 partition=,devicetype,partitiontype,diskid,partitionid This designates a specific partition on a block device. C<< >> is an optional parent device on which to search on, and is often C. Note that the anfgle brackets are part of the syntax. C 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 device by finding a magic file, and C is used for virtual harddisks - F<.vhd> and F<-vhdx> files. The C 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 C identifies the disk or device using a unique signature, and the same is true for the C. How these are interpreted depends on the C: =over =item mbr 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 comamnd typically found on GNU/Linux systems (using e.g. C) can display the disk id. The C is the byte offset(!) of the partition counting from the beginning of the MBR. Example, use the partition on the harddisk with C C<47cbc08a> starting at sector C<2048> (= 1048576 / 512). partition=,harddisk,mbr,47cbc08a,1048576 =item gpt The C is the disk UUID/disk identifier GUID from the partition table (as displayed e.g. by C), and the C is the partition unique GUID (displayed using e.g. the C C 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 raw Instead of diskid and partitionid, 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 legacypartition=,devicetype,partitiontype,diskid,partitionid 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>, rwegardless of any gaps. =item locate=,locatetype,locatearg This device description will make the bootloader search for a partition with a given path. The C<< >> 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. C 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 C and C uses a relative path as C. Example: find any partition which has the C path in the root. locate=,path,\magicfile.xxx Example: find any partition which has the path specified in the C element (typically C<\Windows>). locate=,element,systemroot =item block=devicetype,args... Last not least, the most complex type, C, which... specifies block devices (which could be inside a F file for example). C is one of C, C, C, C, C or C - the same as for C. The remaining arguments change depending on the C: =over =item block=file,,path Interprets the C<< >> device (typically a partition) as a filesystem and specifies a file path inside. =item block=vhd, Pretty much just changes the interpretation of C<< >>, which is usually a disk image (C) to be a F or F file. =item block=ramdisk,,base,size,offset,path Interprets the C<< >> device as RAM disk, using the (decimal) base address, byte size and byte offset inside a file specified by C. The numbers are usually all C<0> because they cna be extracted from the RAM disk image or other parameters. This is most commonly used to boot C images. =item block=floppy,drivenum Refers to a removable drive identified by a number. BCDEDIT cannot display the resultinfg device, and it is not clear what effect it will have. =item block=cdrom,drivenum Pretty much the same as C but for CD-ROMs. =item anything else Probably not yet implemented. Tell me of your needs... =back =back5 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 ave many questions, but I can walk you through some actual examples using mroe complex aspects. =item 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. Bext, 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 locate=,harddisk,mbr,47cbc08a,242643632128>,\win10.vhdx>>,element,path Pretty much the same as the previous case, but witzh 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 {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 initiaolize the ramdisk. The F<\boot.wim> file is then extracted into it. As you cna also see, this F<.sdi> file resides on a different C. Continuitn, as always, form 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. =head1 EDITING BCD DATA 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 exyecuting a series of "editing instructions" which are explained here. =over =item get 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 set I I I Similar to C, but sets the element to the given I instead. Example: change bootmgr default too C<{b097d2ad-bc00-11e9-8a9a-525400123456}>: pbcdedit edit BCD set "{bootmgr}" resumeobject "{b097d2ad-bc00-11e9-8a9a-525400123456}" =item eval 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 expresed like this: pbcdedit edit BCD eval '$BCD->{$DEFAULT}{resumeobject} = "{b097d2ad-bc00-11e9-8a9a-525400123456}"' =item do 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, and some introductory material, try L. For good reference on BCD objects and elements, see Geoff Chappels pages at L. =head1 AUTHOR Written by Marc A. Lehmann . =head1 REPORTING BUGS Bugs can be reported dorectly tt he 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 BEGIN { require "common/sense.pm"; common::sense->import } # common sense is optional, but recommended use Data::Dump; 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]; } 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 } # sources and resources used for this: # 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 = ($s * 1_000_000 + $ms) * 10 + 116_444_736_000_000_000 } # 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 numbes 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) = @_; $hive = regf_encode $hive; open my $regf, ">:raw", "$path~" or die "$path~: $!\n"; print $regf $hive or die "$path~: short write\n"; $regf->sync; close $regf; rename "$path~", $path; } ############################################################################# # bcd stuff # human-readable alises 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 dec_device; sub enc_device; sub enc_integer($) { no warnings 'portable'; # ugh my $value = shift; $value = oct $value if $value =~ /^0[bBxX]/; unpack "H*", pack "Q<", $value } 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 cna be 4 bytes ); our %bcde_enc = ( BCDE_FORMAT_DEVICE , sub { binary => enc_device shift }, 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 = ( 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', 0x22000001 => 'bpbstring', 0x24000001 => 'displayorder', 0x21000001 => 'filedevice', 0x21000001 => 'osdevice', 0x25000001 => 'passcount', 0x26000001 => 'pxesoftreboot', 0x22000002 => 'applicationname', 0x24000002 => 'bootsequence', 0x22000002 => 'filepath', 0x22000002 => 'systemroot', 0x25000002 => 'testmix', 0x26000003 => 'cacheenable', 0x26000003 => 'customsettings', 0x23000003 => 'default', 0x25000003 => 'failurecount', 0x23000003 => 'resumeobject', 0x26000004 => 'failuresenabled', 0x26000004 => 'pae', 0x26000004 => 'stampdisks', 0x25000004 => 'testtofail', 0x25000004 => 'timeout', 0x21000005 => 'associatedosdevice', 0x26000005 => 'cacheenable', 0x26000005 => 'resume', 0x25000005 => 'stridefailcount', 0x26000006 => 'debugoptionenabled', 0x25000006 => 'invcfailcount', 0x23000006 => 'resumeobject', 0x25000007 => 'bootux', 0x25000007 => 'matsfailcount', 0x24000007 => 'startupsequence', 0x25000008 => 'bootmenupolicy', 0x25000008 => 'randfailcount', 0x25000009 => 'chckrfailcount', 0x26000010 => 'detecthal', 0x24000010 => 'toolsdisplayorder', 0x22000011 => 'kernel', 0x22000012 => 'hal', 0x22000013 => 'dbgtransport', 0x26000020 => 'displaybootmenu', 0x25000020 => 'nx', 0x26000021 => 'noerrordisplay', 0x25000021 => 'pae', 0x21000022 => 'bcddevice', 0x26000022 => 'winpe', 0x22000023 => 'bcdfilepath', 0x26000024 => 'hormenabled', 0x26000024 => 'hormenabled', 0x26000024 => 'nocrashautoreboot', 0x26000025 => 'hiberboot', 0x26000025 => 'lastknowngood', 0x26000026 => 'oslnointegritychecks', 0x22000026 => 'passwordoverride', 0x26000027 => 'osltestsigning', 0x22000027 => 'pinpassphraseoverride', 0x26000028 => 'processcustomactionsfirst', 0x27000030 => 'customactions', 0x26000030 => 'nolowmem', 0x26000031 => 'persistbootsequence', 0x25000031 => 'removememory', 0x25000032 => 'increaseuserva', 0x26000032 => 'skipstartupsequence', 0x25000033 => 'perfmem', 0x22000040 => 'fverecoveryurl', 0x26000040 => 'vga', 0x22000041 => 'fverecoverymessage', 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', 0x26000145 => 'enablebootdebugpolicy', 0x26000146 => 'enablebootorderclean', 0x26000147 => 'enabledeviceid', 0x26000148 => 'enableffuloader', 0x26000149 => 'enableiuloader', 0x2600014a => 'enablemassstorage', 0x2600014b => 'enablerpmbprovisioning', 0x2600014c => 'enablesecurebootpolicy', 0x2600014d => 'enablestartcharge', 0x2600014e => 'enableresettpm', 0x21000150 => 'systemdatadevice', 0x21000151 => 'osarcdevice', 0x21000153 => 'osdatadevice', 0x21000154 => 'bspdevice', 0x21000155 => 'bspfilepath', 0x26000202 => 'skipffumode', 0x26000203 => 'forceffumode', 0x25000510 => 'chargethreshold', 0x26000512 => 'offmodecharging', 0x25000aaa => 'bootflow', 0x35000001 => 'ramdiskimageoffset', 0x35000002 => 'ramdisktftpclientport', 0x31000003 => 'ramdisksdidevice', 0x32000004 => 'ramdisksdipath', 0x35000005 => 'ramdiskimagelength', 0x36000006 => 'exportascd', 0x35000007 => 'ramdisktftpblocksize', 0x35000008 => 'ramdisktftpwindowsize', 0x36000009 => 'ramdiskmcenabled', 0x3600000a => 'ramdiskmctftpfallback', 0x3600000b => 'ramdisktftpvarwindow', 0x45000001 => 'devicetype', 0x42000002 => 'applicationrelativepath', 0x42000003 => 'ramdiskdevicerelativepath', 0x46000004 => 'omitosloaderelements', 0x47000006 => 'elementstomigrate', 0x46000010 => 'recoveryos', ); our %rbcde = reverse %bcde; sub dec_bcde_id($) { $bcde{$_[0]} // sprintf "custom:%08x", $_[0] } sub enc_bcde_id($) { $_[0] =~ /^custom:([0-9a-fA-F]{8}$)/ ? hex $1 : $rbcde{$_[0]} } # 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 decoded a device portion after the GUID sub dec_device_($); sub dec_device_($) { my ($device) = @_; 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; $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; $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; $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; 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; $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) = @_; $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; $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) = @_; 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; $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; } 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) = @_; 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; 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}) { $type = $bcd_types{$type} // sprintf "0x%08x", $type; $kv{type} = $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]); my $k = dec_bcde_id $k; $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) // 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], }]] } ############################################################################# 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}"}{resumeobject}; # 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 = $default if $object eq "{default}"; print $bcd->{$object}{$elem}, "\n"; } elsif ($insn eq "set") { my $object = shift @insns; my $elem = shift @insns; my $value = shift @insns; $object = $default if $object eq "{default}"; $bcd->{$object}{$elem} = $value; } elsif ($insn eq "eval") { bcd_edit_eval shift @insns; } 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 edit/parse\n"; } } } ############################################################################# # 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) } # all subcommands our %CMD = ( help => sub { require Pod::Usage; Pod::Usage::pod2usage (-verbose => 2); }, 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 %rbcde = reverse %bcde; $_ = sprintf "%08x", $_ for values %rbcde; my %element; unless ($json) { print "\n"; printf "%-9s %-12s %s\n", "Element", "Format", "Name Alias"; } for my $name (sort keys %rbcde) { my $id = $rbcde{$name}; my $format = $format_name{(hex $id) & BCDE_FORMAT}; if ($json) { $element{$id} = [$format, $name]; } else { printf "%-9s %-12s %s\n", $id, $format, $name; } } print "\n" unless $json; prjson { version => $JSON_VERSION, element => \%element, } if $json; }, export => sub { prjson bcd_decode regf_load shift; }, import => sub { regf_save shift, bcd_encode rdjson; }, edit => sub { my $path = shift; my $bcd = bcd_decode regf_load $path; bcd_edit $path, $bcd, @_; regf_save $path, bcd_encode $bcd; }, 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 { printf "%-10s %-8.8s %-6.6s %-3s %s\n", "DEVICE", "LABEL", "FSTYPE", "PT", "DEVICE DESCRIPTOR"; my $lsblk = $json_coder->decode (scalar qx); for my $dev (@{ $lsblk->{blockdevices} }) { my $pr = sub { printf "%-10s %-8.8s %-6.6s %-3s %s\n", $dev->{path}, $dev->{label}, $dev->{fstype}, $dev->{pttype}, $_[0]; }; if ($dev->{type} eq "part") { if ($dev->{pttype} eq "gpt") { $pr->("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); $pr->("legacypartition=,harddisk,mbr,$diskid,$partno"); if (open my $fh, "/sys/class/block/$dev->{kname}/start") { my $start = 512 * readline $fh; $pr->("partition=,harddisk,mbr,$diskid,$start"); } } } } } }, ); my $cmd = shift; unless (exists $CMD{$cmd}) { warn "Usage: $0 subcommand args...\nTry $0 help\n"; exit 126; } $CMD{$cmd}->(@ARGV);