5 use RFID::Libnfc::Reader;
6 use RFID::Libnfc::Constants;
8 use Digest::MD5 qw(md5_hex);
9 use Getopt::Long::Descriptive;
11 use Data::Dump qw(dump);
13 my ($opt,$usage) = describe_options(
14 '%c %c [dump_with_keys]',
15 [ 'write=s', 'write dump to card' ],
16 [ 'verify!', 'verify writes', { default => 1 } ],
17 [ 'debug|d', 'show debug dumps' ],
18 [ 'help|h', 'usage' ],
20 print $usage->text, exit if $opt->help;
22 my $debug = $ENV{DEBUG} || 0;
23 our $keyfile = shift @ARGV;
24 our ( $tag, $uid, $card_key_file );
28 my $r = RFID::Libnfc::Reader->new(debug => $debug);
30 warn "reader: %s\n", $r->name;
31 my $tag = $r->connect(IM_ISO14443A_106);
40 $uid = sprintf "%02x%02x%02x%02x", @{ $tag->uid };
42 $card_key_file = "cards/$uid.key";
43 $keyfile ||= $card_key_file;
46 warn "# loading keys from $keyfile";
47 $tag->load_keys($keyfile);
48 warn "## _keys = ", dump($tag->{_keys}) if $debug;
51 $tag->select if ($tag->can("select"));
55 print STDERR "reading $uid blocks ";
56 for (my $i = 0; $i < $tag->blocks; $i++) {
57 if (my $data = $tag->read_block($i)) {
58 # if we are dumping an ultralight token,
59 # we receive 16 bytes (while a block is 4bytes long)
60 # so we can skip next 3 blocks
61 $i += 3 if ($tag->type eq "ULTRA");
64 } elsif ( $tag->error =~ m/auth/ ) {
65 warn $tag->error,"\n";
67 # disconnect from reader so we can run mfoc
68 RFID::Libnfc::nfc_disconnect($r->{_pdi});
70 print "Dump this card with mfoc? [y] ";
71 my $yes = <STDIN>; chomp $yes;
72 exit unless $yes =~ m/y/i || $yes eq '';
74 my $file = "cards/$uid.key";
76 warn "# finding keys for card $uid with: mfoc -O $file\n";
77 exec "mfoc -O $file" || die $!;
82 print STDERR "done\n";
84 my $out_file = write_card_dump $tag => $card;
87 $card = read_file $opt->write;
88 foreach my $block ( 0 .. $tag->blocks ) {
89 my $offset = 0x10 * $block;
90 my $data = substr($card,$offset,0x10);
91 print STDERR "writing $uid block $block";
92 $tag->write_block( $block, $data );
94 print STDERR " verify ";
95 my $verify = $tag->read_block( $block );
96 print STDERR $verify eq $data ? "OK" : "ERROR";
100 print STDERR "done\n";
101 unlink $card_key_file;
102 $out_file = write_card_dump $tag => $card;
105 my $txt_file = $out_file;
106 $txt_file =~ s/\.mfd/.txt/ || die "can't change extension of $out_file to txt";
107 system "./mifare-mad.pl $out_file > $txt_file";
108 $ENV{MAD} && system "vi $txt_file";
112 sub write_card_dump {
113 my ( $tag, $card ) = @_;
115 # re-insert keys into dump
116 my $keys = $tag->{_keys} || die "can't find _keys";
117 foreach my $i ( 0 .. $#$keys ) {
118 my $o = $i * 0x40 + 0x30;
119 last if $o > length($card);
121 = substr($card, 0, $o) . $keys->[$i]->[0]
122 . substr($card, $o+6, 4) . $keys->[$i]->[1]
123 . substr($card, $o+16)
125 warn "# sector $i keys re-inserted at $o\n" if $debug;
128 if ( my $padding = 4096 - length($card) ) {
129 warn "# add $padding bytes up to 4k dump (needed for keys loading)\n" if $debug;
130 $card .= "\x00" x $padding;
133 my $md5 = md5_hex($card);
134 my $out_file = "cards/$uid.$md5.mfd";
135 if ( -e $out_file ) {
136 warn "$out_file allready exists, not overwriting\n";
138 write_file $out_file, $card;
139 warn "$out_file ", -s $out_file, " bytes key: $card_key_file\n";
142 if ( ! -e $card_key_file ) {
143 my $source = $out_file;
144 $source =~ s{^cards/}{} || die "can't strip directory from out_file";
145 symlink $source, $card_key_file || die "$card_key_file: $!";
146 warn "$card_key_file symlink created as default key for $uid\n";