| … | |
… | |
| 23 | |
23 | |
| 24 | our $VERSION = '1.4'; |
24 | our $VERSION = '1.4'; |
| 25 | our $JSON_VERSION = 3; # the version of the json objects generated by this program |
25 | our $JSON_VERSION = 3; # the version of the json objects generated by this program |
| 26 | |
26 | |
| 27 | our $CHANGELOG = <<EOF; |
27 | our $CHANGELOG = <<EOF; |
|
|
28 | |
|
|
29 | - work around lsblk bug sometimes giving dos pttype for gpt partitions. |
| 28 | |
30 | |
| 29 | 1.4 Thu Aug 22 10:48:22 CEST 2019 |
31 | 1.4 Thu Aug 22 10:48:22 CEST 2019 |
| 30 | - new "create" subcommand. |
32 | - new "create" subcommand. |
| 31 | - "create" and "edit" try to save and restore ownership/permissions |
33 | - "create" and "edit" try to save and restore ownership/permissions |
| 32 | of bcd hives when writing the new file. |
34 | of bcd hives when writing the new file. |
| … | |
… | |
| 2500 | sub lsblk() { |
2502 | sub lsblk() { |
| 2501 | my $lsblk = $json_coder->decode (scalar qx<lsblk --json -o PATH,KNAME,MAJ:MIN,TYPE,PTTYPE,PTUUID,PARTUUID,LABEL,FSTYPE>); |
2503 | my $lsblk = $json_coder->decode (scalar qx<lsblk --json -o PATH,KNAME,MAJ:MIN,TYPE,PTTYPE,PTUUID,PARTUUID,LABEL,FSTYPE>); |
| 2502 | |
2504 | |
| 2503 | for my $dev (@{ $lsblk->{blockdevices} }) { |
2505 | for my $dev (@{ $lsblk->{blockdevices} }) { |
| 2504 | if ($dev->{type} eq "part") { |
2506 | if ($dev->{type} eq "part") { |
|
|
2507 | |
|
|
2508 | # lsblk sometimes gives a bogus pttype, so we recreate it here |
|
|
2509 | $dev->{pttype} = $dev->{ptuuid} =~ /^$RE_GUID\z/ |
|
|
2510 | ? "gpt" : "dos"; |
|
|
2511 | |
| 2505 | if ($dev->{pttype} eq "gpt") { |
2512 | if ($dev->{pttype} eq "gpt") { |
| 2506 | $dev->{bcd_device} = "partition=<null>,harddisk,gpt,$dev->{ptuuid},$dev->{partuuid}"; |
2513 | $dev->{bcd_device} = "partition=<null>,harddisk,gpt,$dev->{ptuuid},$dev->{partuuid}"; |
| 2507 | } elsif ($dev->{pttype} eq "dos") { # why not "mbr" :( |
2514 | } elsif ($dev->{pttype} eq "dos") { # why not "mbr" :( |
| 2508 | if ($dev->{partuuid} =~ /^([0-9a-f]{8})-([0-9a-f]{2})\z/i) { |
2515 | if ($dev->{partuuid} =~ /^([0-9a-f]{8})-([0-9a-f]{2})\z/i) { |
| 2509 | my ($diskid, $partno) = ($1, hex $2); |
2516 | my ($diskid, $partno) = ($1, hex $2); |
| … | |
… | |
| 2522 | |
2529 | |
| 2523 | sub prdev($$) { |
2530 | sub prdev($$) { |
| 2524 | my ($path, $attribute) = @_; |
2531 | my ($path, $attribute) = @_; |
| 2525 | |
2532 | |
| 2526 | # rather than stat'ing and guessing how devices are encoded, we use lsblk for this |
2533 | # rather than stat'ing and guessing how devices are encoded, we use lsblk for this |
| 2527 | # unfortunately, there doesn't seem to be a way to restrict lsblk to just oned evice, |
|
|
| 2528 | # so we always assume the first one is it. |
|
|
| 2529 | my $mm = $json_coder->decode (scalar qx<lsblk -o MAJ:MIN -J \Q$path\E>)->{blockdevices}[0]{"maj:min"}; |
2534 | my $mm = $json_coder->decode (scalar qx<lsblk -d -o MAJ:MIN -J \Q$path\E>)->{blockdevices}[0]{"maj:min"}; |
| 2530 | |
2535 | |
| 2531 | my $lsblk = lsblk; |
2536 | my $lsblk = lsblk; |
| 2532 | |
2537 | |
| 2533 | for my $dev (@$lsblk) { |
2538 | for my $dev (@$lsblk) { |
| 2534 | if ($dev->{"maj:min"} eq $mm && $dev->{$attribute}) { |
2539 | if ($dev->{"maj:min"} eq $mm && $dev->{$attribute}) { |
