(************************************************************************) (* This file is part of SKS. SKS 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (***********************************************************************) (** Type definitions and simple functions related to PGP packets *) open Printf type ptype = | Reserved | Public_Key_Encrypted_Session_Key_Packet | Signature_Packet | Symmetric_Key_Encrypted_Session_Key_Packet | One_Pass_Signature_Packet | Secret_Key_Packet | Public_Key_Packet | Secret_Subkey_Packet | Compressed_Data_Packet | Symmetrically_Encrypted_Data_Packet | Marker_Packet | Literal_Data_Packet | Trust_Packet | User_ID_Packet | User_Attribute_Packet | Sym_Encrypted_and_Integrity_Protected_Data_Packet | Modification_Detection_Code_Packet | Public_Subkey_Packet | Private_or_Experimental_ptype | Unexpected_ptype type packet = { content_tag: int; packet_type: ptype; packet_length: int; packet_body: string; } type sigsubpacket = { ssp_length: int; ssp_type: int; ssp_body: string; } let ssp_type_to_string i = match i with | 2 -> "signature creation time" | 3 -> "signature expiration time" | 4 -> "exportable certification" | 5 -> "trust signature" | 6 -> "regular expression" | 7 -> "revocable" | 9 -> "key expiration time" | 10 -> "placeholder for backward compatibility" | 11 -> "preferred symmetric algorithms" | 12 -> "revocation key" | 16 -> "issuer key ID" | 20 -> "notation data" | 21 -> "preferred hash algorithms" | 22 -> "preferred compression algorithms" | 23 -> "key server preferences" | 24 -> "preferred key server" | 25 -> "primary user id" | 26 -> "policy URL" | 27 -> "key flags" | 28 -> "signer's user id" | 29 -> "reason for revocation" | x when x >= 100 && x <= 110 -> "internal or user-defined" | _ -> failwith "Unexpected sigsubpacket type" type key = packet list let sigtype_to_string sigtype = match sigtype with | 0x00 -> "signature of binary document" | 0x01 -> "signature of canonical text document" | 0x02 -> "Standalone signature" | 0x10 -> "Generic certification of a User ID and Public Key packet" | 0x11 -> "Persona certification of a User ID and Public Key packet" | 0x12 -> "Casual certification of a User ID and Public Key packet" | 0x13 -> "Positive certification of a User ID and Public Key packet" | 0x18 -> "Subkey Binding Signature" | 0x1F -> "Signature directly on a key" | 0x20 -> "Key revocation signature" | 0x28 -> "Subkey revocation signature" | 0x30 -> "Certification revocation signature" | 0x40 -> "Timestamp signature" | _ -> "UNEXPECTED SIGTYPE" let content_tag_to_ptype tag = match tag with | 0 -> Reserved | 1 -> Public_Key_Encrypted_Session_Key_Packet | 2 -> Signature_Packet | 3 -> Symmetric_Key_Encrypted_Session_Key_Packet | 4 -> One_Pass_Signature_Packet | 5 -> Secret_Key_Packet | 6 -> Public_Key_Packet | 7 -> Secret_Subkey_Packet | 8 -> Compressed_Data_Packet | 9 -> Symmetrically_Encrypted_Data_Packet | 10 -> Marker_Packet | 11 -> Literal_Data_Packet | 12 -> Trust_Packet | 13 -> User_ID_Packet | 14 -> Public_Subkey_Packet | 17 -> User_Attribute_Packet | 18 -> Sym_Encrypted_and_Integrity_Protected_Data_Packet | 19 -> Modification_Detection_Code_Packet | 60 | 61 | 62 | 63 -> Private_or_Experimental_ptype | _ -> Unexpected_ptype let ptype_to_string ptype = match ptype with | Reserved -> "Reserved - a packet tag must not have this value" | Public_Key_Encrypted_Session_Key_Packet -> "Public-Key Encrypted Session Key Packet" | Signature_Packet -> "Signature Packet" | Symmetric_Key_Encrypted_Session_Key_Packet -> "Symmetric-Key Encrypted Session Key Packet" | One_Pass_Signature_Packet -> "One-Pass Signature Packet" | Secret_Key_Packet -> "Secret Key Packet" | Public_Key_Packet -> "Public Key Packet" | Secret_Subkey_Packet -> "Secret Subkey Packet" | Compressed_Data_Packet -> "Compressed Data Packet" | Symmetrically_Encrypted_Data_Packet -> "Symmetrically Encrypted Data Packet" | Marker_Packet -> "Marker Packet" | Literal_Data_Packet -> "Literal Data Packet" | Trust_Packet -> "Trust Packet" | User_ID_Packet -> "User ID Packet" | Public_Subkey_Packet -> "Public Subkey Packet" | User_Attribute_Packet -> "User Attribute Packet" | Sym_Encrypted_and_Integrity_Protected_Data_Packet -> "Sym Encrypted and Integrity Protected Data Packet" | Modification_Detection_Code_Packet -> "Modification Detection Code Packet" | Private_or_Experimental_ptype -> "Private or Experimental Values" | Unexpected_ptype -> "Unexpected value" type mpi = { mpi_bits: int; mpi_data: string; } let pubkey_algorithm_string i = match i with | 1 -> "RSA (Encrypt or Sign)" | 2 -> "RSA Encrypt-Only" | 3 -> "RSA Sign-Only" | 16 -> "Elgamal (Encrypt-Only), see [ELGAMAL]" | 17 -> "DSA (Digital Signature Standard)" | 18 -> "Reserved for Elliptic Curve" | 19 -> "Reserved for ECDSA" | 20 -> "Elgamal (Encrypt or Sign)" | 21 -> "Reserved for Diffie-Hellman (X9.42) as defined for IETF-S/MIME" | x when x >= 100 && x <= 110 -> "Private/Experimental algorithm." | _ -> "Unknown Public Key Algorithm" type pubkeyinfo = { pk_version: int; pk_ctime: int64; pk_expiration: int option; pk_alg: int; pk_keylen: int; } type sigtype = | Signature_of_a_binary_document | Signature_of_a_canonical_text_document | Standalone_signature | Generic_certification_of_a_User_ID_and_Public_Key_packet | Persona_certification_of_a_User_ID_and_Public_Key_packet | Casual_certification_of_a_User_ID_and_Public_Key_packet | Positive_certification_of_a_User_ID_and_Public_Key_packet | Subkey_Binding_Signature | Signature_directly_on_a_key | Key_revocation_signature | Subkey_revocation_signature | Certification_revocation_signature | Timestamp_signature | Unexpected_sigtype type v3sig = { v3s_sigtype: int; v3s_ctime: int64; v3s_keyid: string; v3s_pk_alg: int; v3s_hash_alg: int; v3s_hash_value: string; v3s_mpis: mpi list; } type v4sig = { v4s_sigtype: int; v4s_pk_alg: int; v4s_hashed_subpackets: sigsubpacket list; v4s_unhashed_subpackets: sigsubpacket list; v4s_hash_value: string; v4s_mpis: mpi list; } type signature = V3sig of v3sig | V4sig of v4sig let int_to_sigtype byte = match byte with | 0x00 -> Signature_of_a_binary_document | 0x01 -> Signature_of_a_canonical_text_document | 0x02 -> Standalone_signature | 0x10 -> Generic_certification_of_a_User_ID_and_Public_Key_packet | 0x11 -> Persona_certification_of_a_User_ID_and_Public_Key_packet | 0x12 -> Casual_certification_of_a_User_ID_and_Public_Key_packet | 0x13 -> Positive_certification_of_a_User_ID_and_Public_Key_packet | 0x18 -> Subkey_Binding_Signature | 0x1F -> Signature_directly_on_a_key | 0x20 -> Key_revocation_signature | 0x28 -> Subkey_revocation_signature | 0x30 -> Certification_revocation_signature | 0x40 -> Timestamp_signature | _ -> Unexpected_sigtype let content_tag_to_string tag = ptype_to_string (content_tag_to_ptype tag) let print_packet packet = printf "%s\n" (ptype_to_string packet.packet_type); printf "Length: %d\n" packet.packet_length; if packet.packet_type = User_ID_Packet then (print_string packet.packet_body; print_string "\n") (** write out new-style packet *) let write_packet_new packet cout = (* specify new packet format *) cout#write_byte (packet.content_tag lor 0xC0); cout#write_byte 0xFF; cout#write_int packet.packet_length; cout#write_string packet.packet_body let pk_alg_to_ident i = match i with | 1 -> "R" (* RSA sign and encrypt *) | 2 -> "r" (* RSA encrypt *) | 3 -> "s" (* RSA sign *) | 16 -> "g" (* ElGamal encrypt *) | 20 -> "G" (* ElGamal sign and encrypt *) | 17 -> "D" (* DSA *) | _ -> "?" (* NoClue *) (** writes out packet, using old-style packets when possible *) let write_packet_old packet cout = if packet.content_tag >= 16 then (* write new-style packet *) write_packet_new packet cout else (* write old-style packet *) begin let length_type = if packet.packet_length < 256 then 0 else if packet.packet_length < 65536 then 1 else 2 in cout#write_byte ((packet.content_tag lsl 2) lor 0x80 lor length_type); (match length_type with 0 -> cout#write_byte packet.packet_length | 1 -> cout#write_byte ((packet.packet_length lsr 8) land 0xFF); cout#write_byte (packet.packet_length land 0xFF); | 2 -> cout#write_byte ((packet.packet_length lsr 24) land 0xFF); cout#write_byte ((packet.packet_length lsr 16) land 0xFF); cout#write_byte ((packet.packet_length lsr 8) land 0xFF); cout#write_byte (packet.packet_length land 0xFF); | _ -> failwith "Packet.write_packet_old: Bug -- bad packet length" ); cout#write_string packet.packet_body end let write_packet = write_packet_old