12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163 |
- -module(mysql_protocol).
- -export([handshake/5, quit/2, ping/2,
- query/4, fetch_query_response/3,
- prepare/3, unprepare/3, execute/5, fetch_execute_response/3]).
- -define(MAX_BYTES_PER_PACKET, 16#1000000).
- -include("records.hrl").
- -include("protocol.hrl").
- -include("server_status.hrl").
- -define(ok_pattern, <<?OK, _/binary>>).
- -define(error_pattern, <<?ERROR, _/binary>>).
- -define(eof_pattern, <<?EOF, _:4/binary>>).
- -spec handshake(iodata(), iodata(), iodata() | undefined, atom(), term()) ->
- #handshake{} | #error{}.
- handshake(Username, Password, Database, TcpModule, Socket) ->
- SeqNum0 = 0,
- {ok, HandshakePacket, SeqNum1} = recv_packet(TcpModule, Socket, SeqNum0),
- Handshake = parse_handshake(HandshakePacket),
- Response = build_handshake_response(Handshake, Username, Password,
- Database),
- {ok, SeqNum2} = send_packet(TcpModule, Socket, Response, SeqNum1),
- {ok, ConfirmPacket, _SeqNum3} = recv_packet(TcpModule, Socket, SeqNum2),
- case parse_handshake_confirm(ConfirmPacket) of
- #ok{status = OkStatus} ->
- OkStatus = Handshake#handshake.status,
- Handshake;
- Error ->
- Error
- end.
- -spec quit(atom(), term()) -> ok.
- quit(TcpModule, Socket) ->
- {ok, SeqNum1} = send_packet(TcpModule, Socket, <<?COM_QUIT>>, 0),
- case recv_packet(TcpModule, Socket, SeqNum1) of
- {error, closed} -> ok;
- {ok, ?ok_pattern, _SeqNum2} -> ok
- end.
- -spec ping(atom(), term()) -> #ok{}.
- ping(TcpModule, Socket) ->
- {ok, SeqNum1} = send_packet(TcpModule, Socket, <<?COM_PING>>, 0),
- {ok, OkPacket, _SeqNum2} = recv_packet(TcpModule, Socket, SeqNum1),
- parse_ok_packet(OkPacket).
- -spec query(Query :: iodata(), atom(), term(), timeout()) ->
- {ok, [#ok{} | #resultset{} | #error{}]} | {error, timeout}.
- query(Query, TcpModule, Socket, Timeout) ->
- Req = <<?COM_QUERY, (iolist_to_binary(Query))/binary>>,
- SeqNum0 = 0,
- {ok, _SeqNum1} = send_packet(TcpModule, Socket, Req, SeqNum0),
- fetch_query_response(TcpModule, Socket, Timeout).
- fetch_query_response(TcpModule, Socket, Timeout) ->
- fetch_response(TcpModule, Socket, Timeout, text, []).
- -spec prepare(iodata(), atom(), term()) -> #error{} | #prepared{}.
- prepare(Query, TcpModule, Socket) ->
- Req = <<?COM_STMT_PREPARE, (iolist_to_binary(Query))/binary>>,
- {ok, SeqNum1} = send_packet(TcpModule, Socket, Req, 0),
- {ok, Resp, SeqNum2} = recv_packet(TcpModule, Socket, SeqNum1),
- case Resp of
- ?error_pattern ->
- parse_error_packet(Resp);
- <<?OK,
- StmtId:32/little,
- NumColumns:16/little,
- NumParams:16/little,
- 0,
- WarningCount:16/little>> ->
-
-
-
-
-
- {_ParamDefs, SeqNum3} =
- fetch_column_definitions_if_any(NumParams, TcpModule, Socket,
- SeqNum2),
-
-
-
- {_ColDefs, _SeqNum4} =
- fetch_column_definitions_if_any(NumColumns, TcpModule, Socket,
- SeqNum3),
- #prepared{statement_id = StmtId,
- orig_query = Query,
- param_count = NumParams,
- warning_count = WarningCount}
- end.
- -spec unprepare(#prepared{}, atom(), term()) -> ok.
- unprepare(#prepared{statement_id = Id}, TcpModule, Socket) ->
- {ok, _SeqNum} = send_packet(TcpModule, Socket,
- <<?COM_STMT_CLOSE, Id:32/little>>, 0),
- ok.
- -spec execute(#prepared{}, [term()], atom(), term(), timeout()) ->
- {ok, [#ok{} | #resultset{} | #error{}]} | {error, timeout}.
- execute(#prepared{statement_id = Id, param_count = ParamCount}, ParamValues,
- TcpModule, Socket, Timeout) when ParamCount == length(ParamValues) ->
-
-
-
-
-
- Flags = 0,
- Req0 = <<?COM_STMT_EXECUTE, Id:32/little, Flags, 1:32/little>>,
- Req = case ParamCount of
- 0 ->
- Req0;
- _ ->
-
-
-
- NullBitMap = build_null_bitmap(ParamValues),
-
-
- NewParamsBoundFlag = 1,
- Req1 = <<Req0/binary, NullBitMap/binary, NewParamsBoundFlag>>,
-
-
- EncodedParams = lists:map(fun encode_param/1, ParamValues),
- {TypesAndSigns, EncValues} = lists:unzip(EncodedParams),
- iolist_to_binary([Req1, TypesAndSigns, EncValues])
- end,
- {ok, _SeqNum1} = send_packet(TcpModule, Socket, Req, 0),
- fetch_execute_response(TcpModule, Socket, Timeout).
- fetch_execute_response(TcpModule, Socket, Timeout) ->
- fetch_response(TcpModule, Socket, Timeout, binary, []).
- -spec parse_handshake(binary()) -> #handshake{}.
- parse_handshake(<<10, Rest/binary>>) ->
-
- {ServerVersion, Rest1} = nulterm_str(Rest),
- <<ConnectionId:32/little,
- AuthPluginDataPart1:8/binary-unit:8,
- 0,
- CapabilitiesLower:16/little,
- CharacterSet:8,
- StatusFlags:16/little,
- CapabilitiesUpper:16/little,
- AuthPluginDataLength:8,
- _Reserved:10/binary-unit:8,
- Rest3/binary>> = Rest1,
- Capabilities = CapabilitiesLower + 16#10000 * CapabilitiesUpper,
- Len = case AuthPluginDataLength of
- 0 -> 13;
- K -> K - 8
- end,
- <<AuthPluginDataPart2:Len/binary-unit:8, AuthPluginName/binary>> = Rest3,
- AuthPluginData = <<AuthPluginDataPart1/binary, AuthPluginDataPart2/binary>>,
-
-
-
-
- L = byte_size(AuthPluginName) - 1,
- AuthPluginName1 = case AuthPluginName of
- <<AuthPluginNameTrimmed:L/binary, 0>> -> AuthPluginNameTrimmed;
- _ -> AuthPluginName
- end,
- #handshake{server_version = server_version_to_list(ServerVersion),
- connection_id = ConnectionId,
- capabilities = Capabilities,
- character_set = CharacterSet,
- status = StatusFlags,
- auth_plugin_data = AuthPluginData,
- auth_plugin_name = AuthPluginName1};
- parse_handshake(<<Protocol:8, _/binary>>) when Protocol /= 10 ->
- error(unknown_protocol).
- -spec server_version_to_list(binary()) -> [integer()].
- server_version_to_list(ServerVersion) ->
-
- {match, Parts} = re:run(ServerVersion, <<"^(\\d+)\\.(\\d+)\\.(\\d+)">>,
- [{capture, all_but_first, binary}]),
- lists:map(fun binary_to_integer/1, Parts).
- -spec build_handshake_response(#handshake{}, iodata(), iodata(),
- iodata() | undefined) -> binary().
- build_handshake_response(Handshake, Username, Password, Database) ->
-
- CapabilityFlags0 = ?CLIENT_PROTOCOL_41 bor
- ?CLIENT_TRANSACTIONS bor
- ?CLIENT_SECURE_CONNECTION,
- CapabilityFlags = case Database of
- undefined -> CapabilityFlags0;
- _ -> CapabilityFlags0 bor ?CLIENT_CONNECT_WITH_DB
- end,
- Handshake#handshake.capabilities band CapabilityFlags == CapabilityFlags
- orelse error(old_server_version),
-
-
-
- ClientCapabilityFlags = CapabilityFlags bor
- ?CLIENT_MULTI_STATEMENTS bor
- ?CLIENT_MULTI_RESULTS bor
- ?CLIENT_PS_MULTI_RESULTS,
- Hash = case Handshake#handshake.auth_plugin_name of
- <<>> ->
-
- hash_password(Password, Handshake#handshake.auth_plugin_data);
- <<"mysql_native_password">> ->
- hash_password(Password, Handshake#handshake.auth_plugin_data);
- UnknownAuthMethod ->
- error({auth_method, UnknownAuthMethod})
- end,
- HashLength = size(Hash),
- CharacterSet = ?UTF8,
- UsernameUtf8 = unicode:characters_to_binary(Username),
- DbBin = case Database of
- undefined -> <<>>;
- _ -> <<(iolist_to_binary(Database))/binary, 0>>
- end,
- <<ClientCapabilityFlags:32/little,
- ?MAX_BYTES_PER_PACKET:32/little,
- CharacterSet:8,
- 0:23/unit:8,
- UsernameUtf8/binary,
- 0,
- HashLength,
- Hash/binary,
- DbBin/binary>>.
- -spec parse_handshake_confirm(binary()) -> #ok{} | #error{}.
- parse_handshake_confirm(Packet) ->
- case Packet of
- ?ok_pattern ->
-
- parse_ok_packet(Packet);
- ?error_pattern ->
-
- parse_error_packet(Packet);
- <<?EOF>> ->
-
-
-
-
- error(old_auth);
- <<?EOF, _/binary>> ->
-
-
-
- error(auth_method_switch)
- end.
- -spec fetch_response(atom(), term(), timeout(), text | binary, list()) ->
- {ok, [#ok{} | #resultset{} | #error{}]} | {error, timeout}.
- fetch_response(TcpModule, Socket, Timeout, Proto, Acc) ->
- case recv_packet(TcpModule, Socket, Timeout, any) of
- {ok, Packet, SeqNum2} ->
- Result = case Packet of
- ?ok_pattern ->
- parse_ok_packet(Packet);
- ?error_pattern ->
- parse_error_packet(Packet);
- ResultPacket ->
-
- {ColCount, <<>>} = lenenc_int(ResultPacket),
- R0 = fetch_resultset(TcpModule, Socket, ColCount, SeqNum2),
- case R0 of
- #error{} = E ->
-
- E;
- #resultset{} = R ->
- parse_resultset(R, ColCount, Proto)
- end
- end,
- Acc1 = [Result | Acc],
- case more_results_exists(Result) of
- true ->
- fetch_response(TcpModule, Socket, Timeout, Proto, Acc1);
- false ->
- {ok, lists:reverse(Acc1)}
- end;
- {error, timeout} ->
- {error, timeout}
- end.
- -spec fetch_resultset(atom(), term(), integer(), integer()) ->
- #resultset{} | #error{}.
- fetch_resultset(TcpModule, Socket, FieldCount, SeqNum) ->
- {ok, ColDefs, SeqNum1} = fetch_column_definitions(TcpModule, Socket, SeqNum,
- FieldCount, []),
- {ok, DelimiterPacket, SeqNum2} = recv_packet(TcpModule, Socket, SeqNum1),
- #eof{status = S, warning_count = W} = parse_eof_packet(DelimiterPacket),
- case fetch_resultset_rows(TcpModule, Socket, SeqNum2, []) of
- {ok, Rows, _SeqNum3} ->
- ColDefs1 = lists:map(fun parse_column_definition/1, ColDefs),
- #resultset{cols = ColDefs1, rows = Rows,
- status = S, warning_count = W};
- #error{} = E ->
- E
- end.
- parse_resultset(#resultset{cols = ColDefs, rows = Rows} = R, ColumnCount, text) ->
-
- Rows1 = [decode_text_row(ColumnCount, ColDefs, Row) || Row <- Rows],
- R#resultset{rows = Rows1};
- parse_resultset(#resultset{cols = ColDefs, rows = Rows} = R, ColumnCount, binary) ->
-
- Rows1 = [decode_binary_row(ColumnCount, ColDefs, Row) || Row <- Rows],
- R#resultset{rows = Rows1}.
- more_results_exists(#ok{status = S}) ->
- S band ?SERVER_MORE_RESULTS_EXISTS /= 0;
- more_results_exists(#error{}) ->
- false;
- more_results_exists(#resultset{status = S}) ->
- S band ?SERVER_MORE_RESULTS_EXISTS /= 0.
- -spec fetch_column_definitions(atom(), term(), SeqNum :: integer(),
- NumLeft :: integer(), Acc :: [binary()]) ->
- {ok, ColDefPackets :: [binary()], NextSeqNum :: integer()}.
- fetch_column_definitions(TcpModule, Socket, SeqNum, NumLeft, Acc)
- when NumLeft > 0 ->
- {ok, Packet, SeqNum1} = recv_packet(TcpModule, Socket, SeqNum),
- fetch_column_definitions(TcpModule, Socket, SeqNum1, NumLeft - 1,
- [Packet | Acc]);
- fetch_column_definitions(_TcpModule, _Socket, SeqNum, 0, Acc) ->
- {ok, lists:reverse(Acc), SeqNum}.
- -spec fetch_resultset_rows(atom(), term(), SeqNum :: integer(), Acc) ->
- {ok, Rows, integer()} | #error{}
- when Acc :: [binary()],
- Rows :: [binary()].
- fetch_resultset_rows(TcpModule, Socket, SeqNum, Acc) ->
- {ok, Packet, SeqNum1} = recv_packet(TcpModule, Socket, SeqNum),
- case Packet of
- ?error_pattern ->
- parse_error_packet(Packet);
- ?eof_pattern ->
- {ok, lists:reverse(Acc), SeqNum1};
- Row ->
- fetch_resultset_rows(TcpModule, Socket, SeqNum1, [Row | Acc])
- end.
- parse_column_definition(Data) ->
- {<<"def">>, Rest1} = lenenc_str(Data),
- {_Schema, Rest2} = lenenc_str(Rest1),
- {_Table, Rest3} = lenenc_str(Rest2),
- {_OrgTable, Rest4} = lenenc_str(Rest3),
- {Name, Rest5} = lenenc_str(Rest4),
- {_OrgName, Rest6} = lenenc_str(Rest5),
- {16#0c, Rest7} = lenenc_int(Rest6),
-
- <<Charset:16/little,
- Length:32/little,
- Type:8,
- Flags:16/little,
- Decimals:8,
- 0,
- 0,
- Rest8/binary>> = Rest7,
-
-
-
- <<>> = Rest8,
- #col{name = Name, type = Type, charset = Charset, length = Length,
- decimals = Decimals, flags = Flags}.
- -spec decode_text_row(NumColumns :: integer(),
- ColumnDefinitions :: [#col{}],
- Data :: binary()) -> [term()].
- decode_text_row(_NumColumns, ColumnDefs, Data) ->
- decode_text_row_acc(ColumnDefs, Data, []).
- decode_text_row_acc([ColDef | ColDefs], Data, Acc) ->
- case Data of
- <<16#fb, Rest/binary>> ->
-
- decode_text_row_acc(ColDefs, Rest, [null | Acc]);
- _ ->
-
- {Text, Rest} = lenenc_str(Data),
- Term = decode_text(ColDef, Text),
- decode_text_row_acc(ColDefs, Rest, [Term | Acc])
- end;
- decode_text_row_acc([], <<>>, Acc) ->
- lists:reverse(Acc).
- decode_text(#col{type = T}, Text)
- when T == ?TYPE_TINY; T == ?TYPE_SHORT; T == ?TYPE_LONG; T == ?TYPE_LONGLONG;
- T == ?TYPE_INT24; T == ?TYPE_YEAR ->
- binary_to_integer(Text);
- decode_text(#col{type = T}, Text)
- when T == ?TYPE_STRING; T == ?TYPE_VARCHAR; T == ?TYPE_VAR_STRING;
- T == ?TYPE_ENUM; T == ?TYPE_SET; T == ?TYPE_LONG_BLOB;
- T == ?TYPE_MEDIUM_BLOB; T == ?TYPE_BLOB; T == ?TYPE_TINY_BLOB;
- T == ?TYPE_GEOMETRY; T == ?TYPE_JSON ->
-
-
- Text;
- decode_text(#col{type = ?TYPE_BIT, length = Length}, Text) ->
-
- decode_bitstring(Text, Length);
- decode_text(#col{type = T, decimals = S, length = L}, Text)
- when T == ?TYPE_DECIMAL; T == ?TYPE_NEWDECIMAL ->
-
-
- decode_decimal(Text, L - 2, S);
- decode_text(#col{type = ?TYPE_DATE},
- <<Y:4/binary, "-", M:2/binary, "-", D:2/binary>>) ->
- {binary_to_integer(Y), binary_to_integer(M), binary_to_integer(D)};
- decode_text(#col{type = ?TYPE_TIME}, Text) ->
- {match, [Sign, Hbin, Mbin, Sbin, Frac]} =
- re:run(Text,
- <<"^(-?)(\\d+):(\\d+):(\\d+)(\\.?\\d*)$">>,
- [{capture, all_but_first, binary}]),
- H = binary_to_integer(Hbin),
- M = binary_to_integer(Mbin),
- S = binary_to_integer(Sbin),
- IsNeg = Sign == <<"-">>,
- Fraction = case Frac of
- <<>> -> 0;
- _ when not IsNeg -> binary_to_float(<<"0", Frac/binary>>);
- _ when IsNeg -> 1 - binary_to_float(<<"0", Frac/binary>>)
- end,
- Sec1 = H * 3600 + M * 60 + S,
- Sec2 = if IsNeg -> -Sec1; true -> Sec1 end,
- Sec3 = if IsNeg and (Fraction /= 0) -> Sec2 - 1;
- true -> Sec2
- end,
- {Days, {Hours, Minutes, Seconds}} = calendar:seconds_to_daystime(Sec3),
- {Days, {Hours, Minutes, Seconds + Fraction}};
- decode_text(#col{type = T},
- <<Y:4/binary, "-", M:2/binary, "-", D:2/binary, " ",
- H:2/binary, ":", Mi:2/binary, ":", S:2/binary>>)
- when T == ?TYPE_TIMESTAMP; T == ?TYPE_DATETIME ->
-
- {{binary_to_integer(Y), binary_to_integer(M), binary_to_integer(D)},
- {binary_to_integer(H), binary_to_integer(Mi), binary_to_integer(S)}};
- decode_text(#col{type = T},
- <<Y:4/binary, "-", M:2/binary, "-", D:2/binary, " ",
- H:2/binary, ":", Mi:2/binary, ":", FloatS/binary>>)
- when T == ?TYPE_TIMESTAMP; T == ?TYPE_DATETIME ->
-
- {{binary_to_integer(Y), binary_to_integer(M), binary_to_integer(D)},
- {binary_to_integer(H), binary_to_integer(Mi), binary_to_float(FloatS)}};
- decode_text(#col{type = T}, Text) when T == ?TYPE_FLOAT;
- T == ?TYPE_DOUBLE ->
- try binary_to_float(Text)
- catch error:badarg ->
- try binary_to_integer(Text) of
- Int -> float(Int)
- catch error:badarg ->
-
- binary_to_float(binary:replace(Text, <<"e">>, <<".0e">>))
- end
- end.
- fetch_column_definitions_if_any(0, _TcpModule, _Socket, SeqNum) ->
- {[], SeqNum};
- fetch_column_definitions_if_any(N, TcpModule, Socket, SeqNum) ->
- {ok, Defs, SeqNum1} = fetch_column_definitions(TcpModule, Socket, SeqNum,
- N, []),
- {ok, ?eof_pattern, SeqNum2} = recv_packet(TcpModule, Socket, SeqNum1),
- {Defs, SeqNum2}.
- -spec decode_binary_row(NumColumns :: integer(),
- ColumnDefs :: [#col{}],
- Data :: binary()) -> [term()].
- decode_binary_row(NumColumns, ColumnDefs, <<0, Data/binary>>) ->
- {NullBitMap, Rest} = null_bitmap_decode(NumColumns, Data, 2),
- decode_binary_row_acc(ColumnDefs, NullBitMap, Rest, []).
- decode_binary_row_acc([_|ColDefs], <<1:1, NullBitMap/bitstring>>, Data, Acc) ->
-
- decode_binary_row_acc(ColDefs, NullBitMap, Data, [null | Acc]);
- decode_binary_row_acc([ColDef | ColDefs], <<0:1, NullBitMap/bitstring>>, Data,
- Acc) ->
-
- {Term, Rest} = decode_binary(ColDef, Data),
- decode_binary_row_acc(ColDefs, NullBitMap, Rest, [Term | Acc]);
- decode_binary_row_acc([], _, <<>>, Acc) ->
- lists:reverse(Acc).
- -spec null_bitmap_decode(NumColumns :: integer(), Data :: binary(),
- BitOffset :: integer()) ->
- {NullBitstring :: bitstring(), Rest :: binary()}.
- null_bitmap_decode(NumColumns, Data, BitOffset) ->
-
- BitMapLength = (NumColumns + BitOffset + 7) bsr 3,
- <<NullBitstring0:BitMapLength/binary, Rest/binary>> = Data,
- <<_:BitOffset, NullBitstring:NumColumns/bitstring, _/bitstring>> =
- << <<(reverse_byte(B))/binary>> || <<B:1/binary>> <= NullBitstring0 >>,
- {NullBitstring, Rest}.
- -spec null_bitmap_encode(bitstring(), integer()) -> binary().
- null_bitmap_encode(NullBitstring, BitOffset) ->
- PayloadLength = bit_size(NullBitstring) + BitOffset,
-
- BitMapLength = (PayloadLength + 7) band bnot 7,
- PadBitsLength = BitMapLength - PayloadLength,
- PaddedBitstring = <<0:BitOffset, NullBitstring/bitstring, 0:PadBitsLength>>,
- << <<(reverse_byte(B))/binary>> || <<B:1/binary>> <= PaddedBitstring >>.
- reverse_byte(<<A:1, B:1, C:1, D:1, E:1, F:1, G:1, H:1>>) ->
- <<H:1, G:1, F:1, E:1, D:1, C:1, B:1, A:1>>.
- -spec build_null_bitmap([any()]) -> binary().
- build_null_bitmap(Values) ->
- Bits = << <<(case V of null -> 1; _ -> 0 end):1>> || V <- Values >>,
- null_bitmap_encode(Bits, 0).
- -spec decode_binary(ColDef :: #col{}, Data :: binary()) ->
- {Term :: term(), Rest :: binary()}.
- decode_binary(#col{type = T}, Data)
- when T == ?TYPE_STRING; T == ?TYPE_VARCHAR; T == ?TYPE_VAR_STRING;
- T == ?TYPE_ENUM; T == ?TYPE_SET; T == ?TYPE_LONG_BLOB;
- T == ?TYPE_MEDIUM_BLOB; T == ?TYPE_BLOB; T == ?TYPE_TINY_BLOB;
- T == ?TYPE_GEOMETRY; T == ?TYPE_JSON ->
-
-
- lenenc_str(Data);
- decode_binary(#col{type = ?TYPE_LONGLONG},
- <<Value:64/signed-little, Rest/binary>>) ->
- {Value, Rest};
- decode_binary(#col{type = T}, <<Value:32/signed-little, Rest/binary>>)
- when T == ?TYPE_LONG; T == ?TYPE_INT24 ->
- {Value, Rest};
- decode_binary(#col{type = T}, <<Value:16/signed-little, Rest/binary>>)
- when T == ?TYPE_SHORT; T == ?TYPE_YEAR ->
- {Value, Rest};
- decode_binary(#col{type = ?TYPE_TINY}, <<Value:8/signed, Rest/binary>>) ->
- {Value, Rest};
- decode_binary(#col{type = T, decimals = S, length = L}, Data)
- when T == ?TYPE_DECIMAL; T == ?TYPE_NEWDECIMAL ->
-
-
- {Binary, Rest} = lenenc_str(Data),
- {decode_decimal(Binary, L - 2, S), Rest};
- decode_binary(#col{type = ?TYPE_DOUBLE},
- <<Value:64/float-little, Rest/binary>>) ->
- {Value, Rest};
- decode_binary(#col{type = ?TYPE_FLOAT}, <<0.0:32/float-little, Rest/binary>>) ->
-
- {0.0, Rest};
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<Value:32/float-little, Rest/binary>>) ->
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Factor = math:pow(10, floor(6 - math:log10(abs(Value)))),
- RoundedValue = round(Value * Factor) / Factor,
- {RoundedValue, Rest};
- decode_binary(#col{type = ?TYPE_BIT, length = Length}, Data) ->
- {Binary, Rest} = lenenc_str(Data),
-
- {decode_bitstring(Binary, Length), Rest};
- decode_binary(#col{type = ?TYPE_DATE}, <<Length, Data/binary>>) ->
-
-
- case {Length, Data} of
- {0, _} -> {{0, 0, 0}, Data};
- {4, <<Y:16/little, M, D, Rest/binary>>} -> {{Y, M, D}, Rest}
- end;
- decode_binary(#col{type = T}, <<Length, Data/binary>>)
- when T == ?TYPE_DATETIME; T == ?TYPE_TIMESTAMP ->
-
- case {Length, Data} of
- {0, _} ->
- {{{0, 0, 0}, {0, 0, 0}}, Data};
- {4, <<Y:16/little, M, D, Rest/binary>>} ->
- {{{Y, M, D}, {0, 0, 0}}, Rest};
- {7, <<Y:16/little, M, D, H, Mi, S, Rest/binary>>} ->
- {{{Y, M, D}, {H, Mi, S}}, Rest};
- {11, <<Y:16/little, M, D, H, Mi, S, Micro:32/little, Rest/binary>>} ->
- {{{Y, M, D}, {H, Mi, S + 0.000001 * Micro}}, Rest}
- end;
- decode_binary(#col{type = ?TYPE_TIME}, <<Length, Data/binary>>) ->
-
-
-
-
-
-
-
- case {Length, Data} of
- {0, _} ->
- {{0, {0, 0, 0}}, Data};
- {8, <<0, D:32/little, H, M, S, Rest/binary>>} ->
- {{D, {H, M, S}}, Rest};
- {12, <<0, D:32/little, H, M, S, Micro:32/little, Rest/binary>>} ->
- {{D, {H, M, S + 0.000001 * Micro}}, Rest};
- {8, <<1, D:32/little, H, M, S, Rest/binary>>} ->
-
- Seconds = ((D * 24 + H) * 60 + M) * 60 + S,
-
- {calendar:seconds_to_daystime(-Seconds), Rest};
- {12, <<1, D:32/little, H, M, S, Micro:32/little, Rest/binary>>}
- when Micro > 0 ->
-
- Seconds = -(((D * 24 + H) * 60 + M) * 60 + S),
-
-
- {Days, {Hours, Minutes, Sec}} =
- calendar:seconds_to_daystime(Seconds - 1),
-
- {{Days, {Hours, Minutes, Sec + 1 - 0.000001 * Micro}}, Rest}
- end.
- floor(Value) ->
- Trunc = trunc(Value),
- if
- Trunc =< Value -> Trunc;
- Trunc > Value -> Trunc - 1
- end.
- -spec encode_param(term()) -> {TypeAndSign :: binary(), Data :: binary()}.
- encode_param(null) ->
- {<<?TYPE_NULL, 0>>, <<>>};
- encode_param(Value) when is_binary(Value) ->
- EncLength = lenenc_int_encode(byte_size(Value)),
- {<<?TYPE_VAR_STRING, 0>>, <<EncLength/binary, Value/binary>>};
- encode_param(Value) when is_list(Value) ->
- encode_param(unicode:characters_to_binary(Value));
- encode_param(Value) when is_integer(Value), Value >= 0 ->
-
- if
- Value =< 16#ff ->
- {<<?TYPE_TINY, 16#80>>, <<Value:8>>};
- Value =< 16#ffff ->
- {<<?TYPE_SHORT, 16#80>>, <<Value:16/little>>};
- Value =< 16#ffffffff ->
- {<<?TYPE_LONG, 16#80>>, <<Value:32/little>>};
- Value =< 16#ffffffffffffffff ->
- {<<?TYPE_LONGLONG, 16#80>>, <<Value:64/little>>};
- true ->
-
-
-
- encode_param(integer_to_binary(Value))
- end;
- encode_param(Value) when is_integer(Value), Value < 0 ->
- if
- Value >= -16#80 ->
- {<<?TYPE_TINY, 0>>, <<Value:8>>};
- Value >= -16#8000 ->
- {<<?TYPE_SHORT, 0>>, <<Value:16/little>>};
- Value >= -16#80000000 ->
- {<<?TYPE_LONG, 0>>, <<Value:32/little>>};
- Value >= -16#8000000000000000 ->
- {<<?TYPE_LONGLONG, 0>>, <<Value:64/little>>};
- true ->
- encode_param(integer_to_binary(Value))
- end;
- encode_param(Value) when is_float(Value) ->
- {<<?TYPE_DOUBLE, 0>>, <<Value:64/float-little>>};
- encode_param(Value) when is_bitstring(Value) ->
- Binary = encode_bitstring(Value),
- EncLength = lenenc_int_encode(byte_size(Binary)),
- {<<?TYPE_VAR_STRING, 0>>, <<EncLength/binary, Binary/binary>>};
- encode_param({Y, M, D}) ->
-
- {<<?TYPE_DATE, 0>>, <<4, Y:16/little, M, D>>};
- encode_param({{Y, M, D}, {0, 0, 0}}) ->
-
- {<<?TYPE_DATETIME, 0>>, <<4, Y:16/little, M, D>>};
- encode_param({{Y, M, D}, {H, Mi, S}}) when is_integer(S) ->
-
- {<<?TYPE_DATETIME, 0>>, <<7, Y:16/little, M, D, H, Mi, S>>};
- encode_param({{Y, M, D}, {H, Mi, S}}) when is_float(S) ->
-
-
-
- Sec = trunc(S),
- Micro = round(1000000 * (S - Sec)),
- {<<?TYPE_DATETIME, 0>>, <<11, Y:16/little, M, D, H, Mi, Sec,
- Micro:32/little>>};
- encode_param({D, {H, M, S}}) when is_integer(S), D >= 0 ->
-
- {<<?TYPE_TIME, 0>>, <<8, 0, D:32/little, H, M, S>>};
- encode_param({D, {H, M, S}}) when is_integer(S), D < 0 ->
-
-
- Seconds = ((D * 24 + H) * 60 + M) * 60 + S,
- {D1, {H1, M1, S1}} = calendar:seconds_to_daystime(-Seconds),
- {<<?TYPE_TIME, 0>>, <<8, 1, D1:32/little, H1, M1, S1>>};
- encode_param({D, {H, M, S}}) when is_float(S), D >= 0 ->
- S1 = trunc(S),
- Micro = round(1000000 * (S - S1)),
- {<<?TYPE_TIME, 0>>, <<12, 0, D:32/little, H, M, S1, Micro:32/little>>};
- encode_param({D, {H, M, S}}) when is_float(S), S > 0.0, D < 0 ->
- IntS = trunc(S),
- Micro = round(1000000 * (1 - S + IntS)),
- Seconds = (D * 24 + H) * 3600 + M * 60 + IntS + 1,
- {D1, {M1, H1, S1}} = calendar:seconds_to_daystime(-Seconds),
- {<<?TYPE_TIME, 0>>, <<12, 1, D1:32/little, H1, M1, S1, Micro:32/little>>};
- encode_param({D, {H, M, 0.0}}) ->
- encode_param({D, {H, M, 0}}).
- decode_bitstring(Binary, Length) ->
- PaddingLength = bit_size(Binary) - Length,
- <<_:PaddingLength/bitstring, Bitstring:Length/bitstring>> = Binary,
- Bitstring.
- encode_bitstring(Bitstring) ->
- Size = bit_size(Bitstring),
- PaddingSize = byte_size(Bitstring) * 8 - Size,
- <<0:PaddingSize, Bitstring:Size/bitstring>>.
- decode_decimal(Bin, _P, 0) ->
- binary_to_integer(Bin);
- decode_decimal(Bin, P, S) when P =< 15, S > 0 ->
- binary_to_float(Bin);
- decode_decimal(Bin, P, S) when P >= 16, S > 0 ->
- Bin.
- -spec send_packet(atom(), term(), Data :: binary(), SeqNum :: integer()) ->
- {ok, NextSeqNum :: integer()}.
- send_packet(TcpModule, Socket, Data, SeqNum) ->
- {WithHeaders, SeqNum1} = add_packet_headers(Data, SeqNum),
- ok = TcpModule:send(Socket, WithHeaders),
- {ok, SeqNum1}.
- recv_packet(TcpModule, Socket, SeqNum) ->
- recv_packet(TcpModule, Socket, infinity, SeqNum).
- -spec recv_packet(atom(), term(), timeout(), integer() | any) ->
- {ok, Data :: binary(), NextSeqNum :: integer()} | {error, term()}.
- recv_packet(TcpModule, Socket, Timeout, SeqNum) ->
- recv_packet(TcpModule, Socket, Timeout, SeqNum, <<>>).
- -spec recv_packet(atom(), term(), timeout(), integer() | any, binary()) ->
- {ok, Data :: binary(), NextSeqNum :: integer()} | {error, term()}.
- recv_packet(TcpModule, Socket, Timeout, ExpectSeqNum, Acc) ->
- case TcpModule:recv(Socket, 4, Timeout) of
- {ok, Header} ->
- {Size, SeqNum, More} = parse_packet_header(Header),
- true = SeqNum == ExpectSeqNum orelse ExpectSeqNum == any,
- {ok, Body} = TcpModule:recv(Socket, Size),
- Acc1 = <<Acc/binary, Body/binary>>,
- NextSeqNum = (SeqNum + 1) band 16#ff,
- case More of
- false -> {ok, Acc1, NextSeqNum};
- true -> recv_packet(TcpModule, Socket, Timeout, NextSeqNum,
- Acc1)
- end;
- {error, Reason} ->
- {error, Reason}
- end.
- -spec parse_packet_header(PackerHeader :: binary()) ->
- {PacketLength :: integer(),
- SeqNum :: integer(),
- MorePacketsExist :: boolean()}.
- parse_packet_header(<<PacketLength:24/little-integer, SeqNum:8/integer>>) ->
- {PacketLength, SeqNum, PacketLength == 16#ffffff}.
- -spec add_packet_headers(PacketBody :: iodata(), SeqNum :: integer()) ->
- {PacketWithHeaders :: iodata(), NextSeqNum :: integer()}.
- add_packet_headers(PacketBody, SeqNum) ->
- Bin = iolist_to_binary(PacketBody),
- Size = size(Bin),
- SeqNum1 = (SeqNum + 1) band 16#ff,
-
- if Size < 16#ffffff ->
- {[<<Size:24/little, SeqNum:8>>, Bin], SeqNum1}
- end.
- -spec parse_ok_packet(binary()) -> #ok{}.
- parse_ok_packet(<<?OK:8, Rest/binary>>) ->
- {AffectedRows, Rest1} = lenenc_int(Rest),
- {InsertId, Rest2} = lenenc_int(Rest1),
- <<StatusFlags:16/little, WarningCount:16/little, Msg/binary>> = Rest2,
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- #ok{affected_rows = AffectedRows,
- insert_id = InsertId,
- status = StatusFlags,
- warning_count = WarningCount,
- msg = Msg}.
- -spec parse_error_packet(binary()) -> #error{}.
- parse_error_packet(<<?ERROR:8, ErrNo:16/little, "#", SQLState:5/binary-unit:8,
- Msg/binary>>) ->
-
-
- #error{code = ErrNo, state = SQLState, msg = Msg}.
- -spec parse_eof_packet(binary()) -> #eof{}.
- parse_eof_packet(<<?EOF:8, NumWarnings:16/little, StatusFlags:16/little>>) ->
-
-
- #eof{status = StatusFlags, warning_count = NumWarnings}.
- -spec hash_password(Password :: iodata(), Salt :: binary()) -> Hash :: binary().
- hash_password(Password, Salt) ->
-
-
-
-
-
-
-
-
- PasswordBin = case erlang:is_binary(Password) of
- true -> Password;
- false -> erlang:iolist_to_binary(Password)
- end,
- case PasswordBin =:= <<>> of
- true -> <<>>;
- false -> hash_non_empty_password(Password, Salt)
- end.
- -spec hash_non_empty_password(Password :: iodata(), Salt :: binary()) -> Hash :: binary().
- hash_non_empty_password(Password, Salt) ->
- Salt1 = case Salt of
- <<SaltNoNul:20/binary-unit:8, 0>> -> SaltNoNul;
- _ when size(Salt) == 20 -> Salt
- end,
-
- <<Hash1Num:160>> = Hash1 = crypto:hash(sha, Password),
- Hash2 = crypto:hash(sha, Hash1),
- <<Hash3Num:160>> = crypto:hash(sha, <<Salt1/binary, Hash2/binary>>),
- <<(Hash1Num bxor Hash3Num):160>>.
- -spec lenenc_int(Input :: binary()) -> {Value :: integer(), Rest :: binary()}.
- lenenc_int(<<Value:8, Rest/bits>>) when Value < 251 -> {Value, Rest};
- lenenc_int(<<16#fc:8, Value:16/little, Rest/binary>>) -> {Value, Rest};
- lenenc_int(<<16#fd:8, Value:24/little, Rest/binary>>) -> {Value, Rest};
- lenenc_int(<<16#fe:8, Value:64/little, Rest/binary>>) -> {Value, Rest}.
- -spec lenenc_int_encode(0..16#ffffffffffffffff) -> binary().
- lenenc_int_encode(Value) when Value >= 0 ->
- if Value < 251 -> <<Value>>;
- Value =< 16#ffff -> <<16#fc, Value:16/little>>;
- Value =< 16#ffffff -> <<16#fd, Value:24/little>>;
- Value =< 16#ffffffffffffffff -> <<16#fe, Value:64/little>>
- end.
- -spec lenenc_str(Input :: binary()) -> {String :: binary(), Rest :: binary()}.
- lenenc_str(Bin) ->
- {Length, Rest} = lenenc_int(Bin),
- <<String:Length/binary, Rest1/binary>> = Rest,
- {String, Rest1}.
- -spec nulterm_str(Input :: binary()) -> {String :: binary(), Rest :: binary()}.
- nulterm_str(Bin) ->
- [String, Rest] = binary:split(Bin, <<0>>),
- {String, Rest}.
- -ifdef(TEST).
- -include_lib("eunit/include/eunit.hrl").
- decode_text_test() ->
-
- lists:foreach(fun (T) ->
- ?assertEqual(1, decode_text(#col{type = T}, <<"1">>))
- end,
- [?TYPE_TINY, ?TYPE_SHORT, ?TYPE_LONG, ?TYPE_LONGLONG,
- ?TYPE_INT24, ?TYPE_YEAR]),
-
- <<217>> = decode_text(#col{type = ?TYPE_BIT, length = 8}, <<217>>),
-
- lists:foreach(fun (T) ->
- ?assertEqual(3.0, decode_text(#col{type = T}, <<"3.0">>))
- end,
- [?TYPE_FLOAT, ?TYPE_DOUBLE]),
-
- lists:foreach(fun (T) ->
- ColDef = #col{type = T, decimals = 1, length = 4},
- ?assertMatch(3.0, decode_text(ColDef, <<"3.0">>))
- end,
- [?TYPE_DECIMAL, ?TYPE_NEWDECIMAL]),
- ?assertEqual(3.0, decode_text(#col{type = ?TYPE_FLOAT}, <<"3">>)),
- ?assertEqual(30.0, decode_text(#col{type = ?TYPE_FLOAT}, <<"3e1">>)),
- ?assertEqual(3, decode_text(#col{type = ?TYPE_LONG}, <<"3">>)),
-
- ?assertEqual({2014, 11, 01},
- decode_text(#col{type = ?TYPE_DATE}, <<"2014-11-01">>)),
- ?assertEqual({0, {23, 59, 01}},
- decode_text(#col{type = ?TYPE_TIME}, <<"23:59:01">>)),
- ?assertEqual({{2014, 11, 01}, {23, 59, 01}},
- decode_text(#col{type = ?TYPE_DATETIME},
- <<"2014-11-01 23:59:01">>)),
- ?assertEqual({{2014, 11, 01}, {23, 59, 01}},
- decode_text(#col{type = ?TYPE_TIMESTAMP},
- <<"2014-11-01 23:59:01">>)),
-
- lists:foreach(fun (T) ->
- ColDef = #col{type = T},
- ?assertEqual(<<"x">>, decode_text(ColDef, <<"x">>))
- end,
- [?TYPE_VARCHAR, ?TYPE_ENUM, ?TYPE_TINY_BLOB,
- ?TYPE_MEDIUM_BLOB, ?TYPE_LONG_BLOB, ?TYPE_BLOB,
- ?TYPE_VAR_STRING, ?TYPE_STRING, ?TYPE_GEOMETRY]),
- ok.
- decode_binary_test() ->
-
- ?assertEqual({1.0, <<>>},
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<1.0:32/float-little>>)),
- ?assertEqual({0.2, <<>>},
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<0.2:32/float-little>>)),
- ?assertEqual({-33.3333, <<>>},
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<-33.333333:32/float-little>>)),
- ?assertEqual({0.000123457, <<>>},
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<0.00012345678:32/float-little>>)),
- ?assertEqual({1234.57, <<>>},
- decode_binary(#col{type = ?TYPE_FLOAT},
- <<1234.56789:32/float-little>>)),
- ok.
- null_bitmap_test() ->
- ?assertEqual({<<0, 1:1>>, <<>>}, null_bitmap_decode(9, <<0, 4>>, 2)),
- ?assertEqual(<<0, 4>>, null_bitmap_encode(<<0, 1:1>>, 2)),
- ok.
- lenenc_int_test() ->
-
- ?assertEqual({40, <<>>}, lenenc_int(<<40>>)),
- ?assertEqual({16#ff, <<>>}, lenenc_int(<<16#fc, 255, 0>>)),
- ?assertEqual({16#33aaff, <<>>}, lenenc_int(<<16#fd, 16#ff, 16#aa, 16#33>>)),
- ?assertEqual({16#12345678, <<>>}, lenenc_int(<<16#fe, 16#78, 16#56, 16#34,
- 16#12, 0, 0, 0, 0>>)),
-
- ?assertEqual(<<40>>, lenenc_int_encode(40)),
- ?assertEqual(<<16#fc, 255, 0>>, lenenc_int_encode(255)),
- ?assertEqual(<<16#fd, 16#ff, 16#aa, 16#33>>,
- lenenc_int_encode(16#33aaff)),
- ?assertEqual(<<16#fe, 16#78, 16#56, 16#34, 16#12, 0, 0, 0, 0>>,
- lenenc_int_encode(16#12345678)),
- ok.
- lenenc_str_test() ->
- ?assertEqual({<<"Foo">>, <<"bar">>}, lenenc_str(<<3, "Foobar">>)).
- nulterm_test() ->
- ?assertEqual({<<"Foo">>, <<"bar">>}, nulterm_str(<<"Foo", 0, "bar">>)).
- parse_header_test() ->
-
- Packet = <<16#05, 16#00, 16#00, 16#05, 16#fe, 16#00, 16#00, 16#02, 16#00>>,
- <<Header:4/binary-unit:8, Body/binary>> = Packet,
-
- ?assertEqual({size(Body), 5, false}, parse_packet_header(Header)),
- ok.
- add_packet_headers_test() ->
- {Data, 43} = add_packet_headers(<<"foo">>, 42),
- ?assertEqual(<<3, 0, 0, 42, "foo">>, list_to_binary(Data)).
- parse_ok_test() ->
- Body = <<0, 5, 1, 2, 0, 0, 0, "Foo">>,
- ?assertEqual(#ok{affected_rows = 5,
- insert_id = 1,
- status = ?SERVER_STATUS_AUTOCOMMIT,
- warning_count = 0,
- msg = <<"Foo">>},
- parse_ok_packet(Body)).
- parse_error_test() ->
-
- Body = <<255, 42, 0, "#", "XYZxx", "Foo">>,
- ?assertEqual(#error{code = 42, state = <<"XYZxx">>, msg = <<"Foo">>},
- parse_error_packet(Body)),
- ok.
- parse_eof_test() ->
-
- Packet = <<16#05, 16#00, 16#00, 16#05, 16#fe, 16#00, 16#00, 16#02, 16#00>>,
- <<_Header:4/binary-unit:8, Body/binary>> = Packet,
-
- ?assertEqual(#eof{warning_count = 0,
- status = ?SERVER_STATUS_AUTOCOMMIT},
- parse_eof_packet(Body)),
- ok.
- hash_password_test() ->
- ?assertEqual(<<222,207,222,139,41,181,202,13,191,241,
- 234,234,73,127,244,101,205,3,28,251>>,
- hash_password(<<"foo">>, <<"abcdefghijklmnopqrst">>)),
- ?assertEqual(<<>>, hash_password(<<>>, <<"abcdefghijklmnopqrst">>)).
- -endif.
|